delete mulitple column

[gint32]

Hi Everyone,
I am trying to figure out a way of deleting multiple columns within on one worksheet based the headers or one step better would be to use vba find the column headers I want to keep and delete all the rest. I like to be able to have a list of header names stored in vba (and not the worksheet) then have the code find where they each are and delete or like i said prefer to keep the headers I want and delete all other columns at once rather than using the traditional way such as below.

The reason for this is every now and then the IT dept change the SQL by adding either extra columns or move them around which in turn completley messes up my multiple Macros each time they do this.

    Range("A:A,H:H,I:I,K:K,L:L,Q:Q,S:S,T:T,U:U,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA,AB:AF"). _
        Select
      Selection.Delete Shift:=xlToLeft

I started using putting some code (very long winded vba) below to try and accompish this but I am struggling as this is a one column at a time way, but its the only way I know, so the help i need is :
I need an array to read in the header values from a list(stored in VBA not the worksheet) then go find these then delete all else (so easy to say in english) eh!"

Sub Find_SpecificText()

Dim lCol As Long: Dim rng, cell As Range: Dim specificText As String
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = Range("A1:ZZ" & lCol): specificText = "Unit"
 For Each cell In rng
 
 'MsgBox cell.Column
 
 If UCase(cell.Value) = UCase(specificText) Then
        '
        MsgBox "Found value " & specificText & vbCr & vbCr & cell.Address & vbCr & vbCr & " Column number " & cell.Column, vbInformation, "    Gerry VBa Searching for Text in Row/Column"
        Col_Numb = cell.Column ' set variable long as = column number
        
       'I've also declared  ...Public Col_Numb As Long and  ColumnLetterVar as variant' not sure this is the way forward
        
       ColumnLetterVar = Col_Letter(Col_Numb) ''set this as global variable to be used anywhere in subs
      
      'MsgBox Col_Letter(Col_Numb)
              MsgBox "The Header ...'" & specificText & "'" & vbCr & " is in Column .... " & _
       ColumnLetterVar, _
       vbInformation, "Find specific text"
       
            Stop
                Exit Sub
 
 End If
 
 Next
      MsgBox specificText & ".... IT Dept have moved the columns around again..or text is Not found"
End Sub

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

 

[gint32]

Hi Everyone...another approach would be to find the column/s that I am after (based on the text in the header) and copy each column found to another worksheet using and list of already known headers names ..this would at least save on the deleting part of the vba.

 

[Fluff]

How many columns are there to be kept?

 

[gint32]

Sorry for the delay in response, I never got or noticed the reply till now. it varies from one sub to another, but for testing purpose lets say 10 columns that I wish to keep, read from a array or list.. thanks
such as

DATE_FROM
DATE_TO
EVENT_ID
EVENT_TYPE
EVENT_DATE
EVENT_DATE_SORT
EVENT_TIME_FROM
EVENT_TIME_TO
EVENT_LOCATION
EVENT_FACILITATOR

 

[Fluff]

Ok, how about

Sub gint()
   Dim Ary As Variant
   Dim Dic As Object
   Dim Cl As Range, Rng As Range
   Dim i As Long
   
   Ary = Array("DATE_FROM", "DATE_TO", "EVENT_ID", "EVENT_TYPE", "EVENT_DATE", "EVENT_DATE_SORT", "EVENT_TIME_FROM", "EVENT_TIME_TO", "EVENT_LOCATION", "EVENT_FACILITATOR")
   Set Dic = CreateObject("Scripting.dictionary")
   For i = LBound(Ary) To UBound(Ary)
      Dic(Ary(i)) = Empty
   Next i
   For Each Cl In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
      If Not Dic.Exists(Cl.Value) Then
         If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
      End If
   Next Cl
   If Not Rng Is Nothing Then Rng.EntireColumn.Delete
End Sub

 

[gint32]

Thanks Fluff, I tested your vba this morning and it works perfectly...thanks and have a great xmas and newyears

 

[Fluff]

You're welcome & thanks for the feedback.