Find string in row and copy whole column to new sheet - excel

Question

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

Answer 1

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