See if this works. Try on a copy of your workbook.
Change the Sheet reference (here Sheet2) as required
Sub Keep_Certain_Columns()
Dim x As String, lc As Long, arr1, i As Long
arr1 = Array("gen", "red", "white")
lc = Cells(2, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
With Sheets("Sheet2") '<-----
For i = LBound(arr1) To UBound(arr1)
x = .Range(.Cells(2, 1), .Cells(2, lc)).Find(arr1(i), LookIn:=xlValues).Address
.Range(x).EntireColumn.Copy ActiveSheet.Cells(1, i + 1)
Next i
End With
With Sheets("Sheet2") '<-----
.Cells.ClearContents
End With
Range(Columns(1), Columns(UBound(arr1) + 1)).Copy Sheets("Sheet2").Range("A1") '<-----
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Sheets("Sheet2").Select '<-----
Application.ScreenUpdating = True
End Sub
Let us know if either John H Davis' code or this code works for you
Bookmarks