Find string in row and copy whole column to new sheet

user_3270033 0
Viewed 66

I'm trying to find a column with a string of text and copy it into another sheet. The top row would contain text "Module Check" but might have other text after or before. I know that I can do the following if I know the exact string. How do I search for a string in the top row and then select the whole column based on that string?

Sub FinalAssignmentImportedtoCleaned()
   
    Sheets("Imported").Select
    Set MR = Range("A1:ZZ1")
    For Each Cell In MR
        If Cell.Value = "Module Check" Then Cell.EntireColumn.Copy
    Next
    Sheets("Cleaned").Select
    Range("D:D").Select
    ActiveSheet.Paste
    [D1].Value = "Module Check"
End Sub
vba excel
1 Answers

The Like operator will match pattern of a string against the full string. That's useful when you want to use wildcard in your match.

So change = with Like and this code If Cell.Value Like "*Module Check*" Then Cell.EntireColumn.Copy should do the trick.

If you want to check if only word exist in the end of the sentence you can do "*Module Check"

If you want to avoid case-sensitivity you can use LCase$(), i.e.

If LCase$(Cell.Value) Like LCase$("*Module Check*") Then Cell.EntireColumn.Copy

If you want to avoid select and make code more robust you could rewrite it a little bit:

Sub FinalAssignmentImportedtoCleaned()
    
    Dim lcol As Long
    Dim ws_copy As Worksheet 'Declare sheet to copy from
    Dim ws_paste As Worksheet 'Declare sheet to paste to

    Set ws_copy = ActiveWorkbook.Worksheets("Imported") 'Set sheet name to copy from
    Set ws_paste = ActiveWorkbook.Worksheets("Cleaned") 'Set sheet name to paste to
    
    lcol = ws_copy.Cells(1, Columns.Count).End(xlToLeft).Column 'Find last column with data at row 1
    
    Set MR = ws_copy.Range(ws_copy.Cells(1, "A"), ws_copy.Cells(1, lcol))
    For Each Cell In MR
        If Cell.Value Like "*Module Check*" Then Cell.EntireColumn.Copy
    Next
    ws_paste.Range("D1").PasteSpecial
    ws_paste.Cells(1, "D").Value = "Module Check"
End Sub
user_45525290
Related