VBA Auto delete unwanted Columns

[usui]

Hi Masters, can anyone help me create a VBA code that can help remove unwanted columns start from column H..

I want a VBA that I can enter just the column header that I want to remain in the sheets.

Sample: I want to enter " Tea " in the input box then all other columns with different headers will be remove starting from column H only.

I hope someone can help with this problem.

 

[Joe4]

Assuming that your headers are in row 1, try this:

Sub MyDeleteColumns()

    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")
        
'   Find last column in row 1
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    
'   Loop through all columns backwards and delete if not equal to entered in name
    For c = lc To 8 Step -1
        If Cells(1, c).Value <> colHdr Then Columns(c).Delete
    Next c
    
    Application.ScreenUpdating = True
    
End Sub

 

[usui]

Assuming that your headers are in row 1, try this:

Sub MyDeleteColumns()

    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")
       
'   Find last column in row 1
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
'   Loop through all columns backwards and delete if not equal to entered in name
    For c = lc To 8 Step -1
        If Cells(1, c).Value <> colHdr Then Columns(c).Delete
    Next c
   
    Application.ScreenUpdating = True
   
End Sub

Can this also work on multiple sheets or workbook?

 

[usui]

Assuming that your headers are in row 1, try this:

Sub MyDeleteColumns()

    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")
       
'   Find last column in row 1
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
'   Loop through all columns backwards and delete if not equal to entered in name
    For c = lc To 8 Step -1
        If Cells(1, c).Value <> colHdr Then Columns(c).Delete
    Next c
   
    Application.ScreenUpdating = True
   
End Sub

I have tried this but it also removes the column header that I entered.. headers are located at Row 3..i tried changing it to row 3 but still the same

if possible is there a way make those unwanted columns to be hide instead of deleted??

 

[usui]

Assuming that your headers are in row 1, try this:

Sub MyDeleteColumns()

    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")
       
'   Find last column in row 1
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
'   Loop through all columns backwards and delete if not equal to entered in name
    For c = lc To 8 Step -1
        If Cells(1, c).Value <> colHdr Then Columns(c).Delete
    Next c
   
    Application.ScreenUpdating = True
   
End Sub

It's working now, yehey..the only problem is that it only works on 1 sheet... do you have a code to make it work on multiple sheets or in 1 workbook??

 

[Joe4]

It's working now, yehey..the only problem is that it only works on 1 sheet... do you have a code to make it work on multiple sheets or in 1 workbook??

Just wrap it in a loop that goes through all worksheets, i.e.

Sub MyDeleteColumns()

    Dim ws As Worksheet
    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")

'   Loop through all worksheets
    For Each ws In Worksheets
        ws.Activate
        
'       Find last column in row 1
        lc = Cells(1, Columns.Count).End(xlToLeft).Column
    
'       Loop through all columns backwards and delete if not equal to entered in name
        For c = lc To 8 Step -1
            If Cells(1, c).Value <> colHdr Then Columns(c).Delete
        Next c
        
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

 

[Joe4]

And per forum rules, please do NOT start new threads on the same subject!
Note that you might not always get immediate replies (I do sleep sometimes), so you may need to be a little patient.

 

[usui]

Just wrap it in a loop that goes through all worksheets, i.e.

Sub MyDeleteColumns()

    Dim ws As Worksheet
    Dim colHdr As String
    Dim lc As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Prompt for name of column
    colHdr = InputBox("Enter name of column that you would like to keep")

'   Loop through all worksheets
    For Each ws In Worksheets
        ws.Activate
       
'       Find last column in row 1
        lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
'       Loop through all columns backwards and delete if not equal to entered in name
        For c = lc To 8 Step -1
            If Cells(1, c).Value <> colHdr Then Columns(c).Delete
        Next c
       
    Next ws
   
    Application.ScreenUpdating = True
   
End Sub

OMG..you are a life saver Joe4..thank you so much for the great help

 

[usui]

And per forum rules, please do NOT start new threads on the same subject!
Note that you might not always get immediate replies (I do sleep sometimes), so you may need to be a little patient.

this is noted. thank you

 

[Joe4]

You are welcome.
Glad we could help.