Delete multiple columns from Multiple sheets - arrays

Question

I am trying to delete Multiple columns from Multiple sheets while retaining those found in a list.
For example I have sheet1, sheet2, sheet3, ..., sheet7.
From these sheets I have particular columns to be keep like.
From sheet1 I want keep columns like s.no, cust.name, product, date remaining all should be deleted same from sheet2 I want to keep prod.disc,address, pin remaining all should be deleted like I have remaining sheets in that I want to keep particular columns remaining all should be deleted.
I am trying to do using arrays but not able start how to do. I have basic syntax.
Sub sbVBS_To_Delete_Specific_Multiple_Columns()
Sheets("Sheet1").Range("A:A,C:C,H:H,K:O,Q:U").EntireColumn.Delete
End Sub`[code]
But that didn't work for me because in future some columns may add in it and I want columns should recognize with name which column to keep and remaining to discard.

Answer 1

OK, here is the basic code. Specify the worksheet and the columns to be deleted in the main procedure. Set the row in which to find the captions in the sub-procedure.
Sub DeleteColumns()
' 17 Mar 2017
Dim ClmCaption As Variant
Dim Ws As Worksheet
Dim i As Integer
Set Ws = ActiveSheet
' better to specify the sheet by name, like Set Ws = ThisWorkbook.Worksheets("My Excel")
Application.ScreenUpdating = False ' freeze screen (speeds up execution)
ClmCaption = Array("One", "two", "three", "four", "five")
' specify all the columns you want to delete by caption , not case sensitive
For i = 0 To UBound(ClmCaption) ' loop through all the captions
DelColumn Ws, CStr(ClmCaption(i)) ' call the sub for each caption
Next i
Application.ScreenUpdating = True ' update screen
End Sub
Private Sub DelColumn(Ws As Worksheet, Cap As String)
' 17 Mar 2017
Dim CapRow As Long
Dim Fnd As Range
CapRow = 3 ' this is the row where the captions are
Set Fnd = Ws.Rows(CapRow).Find(Cap) ' find the caption
If Fnd Is Nothing Then
MsgBox "The caption """ & Cap & """ doesn't exist." & vbCr & _
"The column wasn't deleted.", _
vbInformation, "Invalid parameter"
Else
Ws.Columns(Fnd.Column).EntireColumn.Delete Shift:=xlToLeft
End If
End Sub
You can run the code as it is but you will get a lot of error messages because the specified captions don't exist.

Answer 2

The following uses a Scripting Dictionary object that maintains a list of worksheets to be processed as the dictionary keys with an array of column header labels to keep as the associated items.
Option Explicit
Sub delColumnsNotInDictionary()
Dim d As Long, ky As Variant, dict As Object
Dim c As Long, lc As Long
Set dict = CreateObject("Scripting.Dictionary")
dict.comparemode = vbTextCompare
dict.Item("Sheet1") = Array("s.no", "cust.name", "product", "date")
dict.Item("Sheet2") = Array("prod.disc", "address", "pin")
dict.Item("Sheet50") = Array("foo", "bar")
With ThisWorkbook
For Each ky In dict.keys
With Worksheets(ky)
lc = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Column
For c = lc To 1 Step -1
'filter array method of 'not found in array'
'WARNING! CASE SENSITIVE SEARCH - foo <> FOO
If UBound(Filter(dict.Item(ky), .Cells(1, c).Value2)) = -1 Then
'.Cells(1, c).EntireColumn.Delete
Else
Debug.Print .Cells(1, c).Value2 & " at " & _
UBound(Filter(dict.Item(ky), .Cells(1, c).Value2))
End If
'worksheet MATCH method of 'not found in array'
'Case insensitive search - foo == FOO
If IsError(Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)) Then
.Cells(1, c).EntireColumn.Delete
Else
Debug.Print .Cells(1, c).Value2 & " at " & _
Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)
End If
Next c
End With
Next ky
End With
dict.RemoveAll: Set dict = Nothing
End Sub
Note that I have included two methods for determining whether a column header label is within the array of columns to keep. One is case-sensitive (the array Filter method) and the other is not (worksheet function MATCH method). The case-insensitive search method is currently active.