Delete multiple columns based on value in first row

Hi all,

I have big table with many columns. From those columns I need to keep only several. The rest I need to delete. Can anyone help me with a macro which will delete all necessary columns.

The table I have is in sheet “Table”, columns A to ZZ. The number of rows can vary. Column names are in the first row (A1:ZZ1).
The list with all column names that I need to keep is in the sheet “Required columns”, range A1:A12.

Thank you in advance for your help.

Igor

Can you provide the list in Sheet "Required Columns" ?

Hi Sourabhg98,
The code works good, but I need to keep the columns that are in the list.
If there is column which is not in the list, then to delete it.
Thank you!
Igor

Hi JOHN H. DAVIS,
The list is not fixed. It can change over time. Please use the example that Sourabhg98 shared.
Igor

Maybe:

Sub igormigor()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, y As Long, z As Long, r As Range
Set ws = Sheets("Table")
Set ws1 = Sheets("Required Columns")
With ws
            For i = 1 To ws1.Range("A" & Rows.Count).End(3).row
                Set r = .Rows(1).Find(ws1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not r Is Nothing Then r.Interior.ColorIndex = 6
                Set r = Nothing
            Next i
        y = .UsedRange.Columns.Count
            For z = y To 1
                Select Case .Cells(1, z).Interior.ColorIndex
                    Case Is = 6
                        GoTo zz
                    Case Else
                        .Columns(z).Delete
                End Select
zz:
            Next z
            .Rows(1).Interior.ColorIndex = xlNone
End With

End Sub

Depending on your Sheet's formatting.

your code did not worked fully. I've made some changes. Its little messy, but it works.

Thank you JOHN H. DAVIS and Sourabhg98 for your help.

Sub igormigor()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, y As Long, z As Long, r As Range
Set ws = Sheets("Table")
Set ws1 = Sheets("Required Columns")

  ws.Range("1:1").Interior.ColorIndex = 10
With ws
            For i = 1 To ws1.Range("A" & Rows.Count).End(3).Row
                Set r = .Rows(1).Find(ws1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not r Is Nothing Then r.Interior.ColorIndex = 6
                Set r = Nothing
            Next i
        
        y = .UsedRange.Columns.Count
            For z = y To 1
                Select Case .Cells(1, z).Interior.ColorIndex
                    Case Is = 6
                        GoTo zz
                    Case Else
                        .Columns(z).Delete
                End Select
zz:
            Next z
End With

With ws
            For i = 1 To 100
                If Sheets("Table").Range("a" & i).Interior.ColorIndex = 10 Then
                                        .Columns(z).Delete
                End If
            Next i
End With
 
  x = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
 
xxx:
 For i = 1 To x
        If ws.Cells(1, i).Interior.ColorIndex <> "6" Then
       Columns(i).EntireColumn.Delete
       i = i + 1
    End If

Next i

    test1 = WorksheetFunction.CountA(ws.Range("1:1"))
    test2 = WorksheetFunction.CountA(ws1.Range("A:A"))

        If test1 = test2 Then
            Else
            GoTo xxx
        End If
  ws.Range("1:1").Interior.ColorIndex = xlNone

End Sub