Sub deletecol()
Dim rng As Range
Dim c As Range
Dim v As Variant
Dim cfind As Range
Dim x() As Variant, j As Integer, k As Integer
Dim cfind1 As Range
Worksheets("main data").Activate
Set rng = Range("A1:A100")
For Each c In rng
v = c.Offset(0, 1)
With Worksheets("criteria")
Set cfind = .Cells.Find(what:=v, lookat:=xlWhole)
If Not cfind Is Nothing Then
j = WorksheetFunction.CountA(cfind.Offset(0, 1), cfind.End(xlToRight))
ReDim x(1 To j)
For k = 1 To j
x(k) = cfind.Offset(0, k)
Next k
End If
End With
For k = 1 To j
Set cfind1 = Rows(c.Row).Cells.Find(what:=x(k), lookat:=xlWhole)
cfind1.EntireColumn.Delete
Next k
Next c
'If Range("C1").Value = c Then
''Range("C2").Value = c.Offset(0, 1).Value
'v = Array((c.Offset(0, 1).Value))
'LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'For delcol = LastCol To 1 Step -1
'bFound = False
'For x = LBound(v) To UBound(v)
' If InStr(1, Cells(1, delcol), v(x), vbTextCompare) And _
' Len(Cells(1, delcol)) = Len(v(x)) Then
' bFound = True
' Exit For
' End If
'Next x
'If bFound Then _
' Cells(1, delcol).EntireColumn.Delete
'Next delcol
'End If
'Next c
End Sub
