delete mulitple column

gint32

Board Regular
Joined
Oct 8, 2014
Messages
139
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.

VBA Code:
    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!"
VBA Code:
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

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

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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.
 
Upvote 0
How many columns are there to be kept?
 
Upvote 0
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
Rich (BB code):
DATE_FROMDATE_TOEVENT_IDEVENT_TYPEEVENT_DATEEVENT_DATE_SORTEVENT_TIME_FROMEVENT_TIME_TOEVENT_LOCATIONEVENT_FACILITATOR
 
Upvote 0
Ok, how about
VBA Code:
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
 
Upvote 0
Solution
Thanks Fluff, I tested your vba this morning and it works perfectly...thanks and have a great xmas and newyears :)
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,528
Messages
6,114,154
Members
448,553
Latest member
slaytonpa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top