Can you delete a column based on a cell value?

[iwilli]

I have a report I download weekly from the corp. site. It contains sales stats for the previous week. I spend a lot of time rearranging the data so I can prepare weekly presentation for several managers. I built macros that deleted the column I don't need and that really sped things up. But know for some reason corporate keeps changing the format and my macros are deleting the wrong columns. Is there VBA code that will search for specific text in the first row of each column and delete the column if it doesn't match?

Cross Post: Excel Forum

 

[iwilli]

Here the code. Please keep in mind I am still learning VBA and I used the Macro recorder to make this. Where I need help is right at the beginning. I delete a bunch of columns but now I want to know if you can delete a column based on the cell value. Example I delete A through M I want it to look at the first cell in row one of each column and if it doesn't match my critira then the whole column is deleted. Possible?

Sub Wkly_Kickoff_Prep_Update()
'
' Wkly_Kickoff_Prep_Update Macro
'

'
    Columns("A:M").Delete Shift:=xlToLeft
    Rows("1:1").WrapText = True
    Columns("B:B").Delete Shift:=xlToLeft
    Columns("B:D").Delete Shift:=xlToLeft
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("H:J").Delete Shift:=xlToLeft
    Columns("I:I").Delete Shift:=xlToLeft
    Columns("K:AC").Delete Shift:=xlToLeft
    Columns("L:P").Delete Shift:=xlToLeft
    Columns("C:C").Delete Shift:=xlToLeft
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .ThemeColor = xlThemeColorLight2
    End With
    Range("E1").Select

 

[JazzSP8]

Hi

This is some code I've got saved away that checks for words in columns in one of my worksheets. Change the "Delete" to your need(s) and it should work for you.

Sub DeleteCol()

Set r = ActiveSheet.UsedRange.Resize(1)

LC = r(r.Count).Column

For x = LC To 1 Step -1
    If Application.CountIf(Columns(x), "Delete") > 0 Then
        Columns(x).EntireColumn.Delete
    End If
Next x

End Sub

Hope that makes sense

 

[iwilli]

JazzSP8-
Thanks for the help. I wish it made sense. I guess I'm still to new to VBA.

 

[JazzSP8]

You need to amend this line;

If Application.CountIf(Columns(x), "Delete") > 0 Then

To look for the value you want to delete, so if you have a header that is "Price" that you want to delete then you do;

If Application.CountIf(Columns(x), "Price") > 0 Then

 

[kpark91]

Just a little twist to JazzSP8's code

Sub deleteSpecificTextColumn()
    Application.ScreenUpdating = False
    Dim i As Long, LC As Integer, lookFor As String, count As Integer
    
    count = 0
    '16384 is the limit number for Excel 2007, if you're using excel below 2007, replace 16384 with 256
    LC = Cells(1, 16384).End(xlToLeft).Column
    lookFor = InputBox("What text do you want to look for in the first row? (case-sensitive)")
    If lookFor = "" Then
        Exit Sub
    End If
    lookFor = "*" & lookFor & "*"
    
    For i = LC To 1 Step -1
        If Cells(1, i).Value Like lookFor Then
            count = count + 1
            Columns(i).EntireColumn.Delete
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Done! Found " & count & "."
End Sub

You can put this into your worksheet module and run
and type in part or all of the word into the inputbox.
It is case sensitive.

 

[iwilli]

Thanks this is great. Here is the problem I am running into now. I have only 11 columns I want to keep and 65 I don't want.

Okay I found this but now I don't understand why it doesn't delete all of the rows I don't want. Can someone explain what I am missing?

    Dim c As Range, rngCol
     
    'Set rngCol = Range("A1", Range("IV1").End(xlToLeft))
    Set rngCol = [A1:BM1]
     
    For Each c In rngCol
        If c.Value <> "Advisor AO Number" And c.Value <> "Advisor Number" And c.Value <> "Advisor Name" _
        And c.Value <> "Advisor Last Name" And c.Value <> "Weekly Total GDC" And c.Value <> "Weekly Plans" And c.Value <> "Weekly CA's" And c.Value <> "Calendar Year-to-Date Total GDC" And c.Value <> _
        "Calendar Year-to-Date Plans" And c.Value <> "Calendar Year-to-Date CA's" And c.Value <> "26 Pd Moving Total GDC" Then
            c.EntireColumn.Delete
        End If
    Next c

 

[JazzSP8]

You generally have to work backwards when deleting Rows / Columns...

Based on the code you posted I adapted the one I posted, this should work for you assuming that the values you are trying to match against are in Row 1.

Sub DeleteCol()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set r = ActiveSheet.UsedRange.Resize(1)

LC = r(r.Count).Column

For x = LC To 1 Step -1

    If Cells(1, x).Value <> "Advisor AO Number" And Cells(1, x).Value <> "Advisor Number" And Cells(1, x).Value <> "Advisor Name" And Cells(1, x).Value <> "Advisor Last Name" And Cells(1, x).Value <> "Weekly Total GDC" And Cells(1, x).Value <> "Weekly Plans" And Cells(1, x).Value <> "Weekly CA's" And Cells(1, x).Value <> "Calendar Year-to-Date Plans" And Cells(1, x).Value <> "Calendar Year-to-Date CA's" And Cells(1, x).Value <> "26 Pd Moving Total GDC" Then
        Columns(x).EntireColumn.Delete
    End If
Next x

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

If it's not Row 1 then change the 1 in this line to match;

If Cells(1, x).Value

HTH

 

[iwilli]

You generally have to work backwards when deleting Rows / Columns...

Based on the code you posted I adapted the one I posted, this should work for you assuming that the values you are trying to match against are in Row 1.

Sub DeleteCol()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set r = ActiveSheet.UsedRange.Resize(1)

LC = r(r.Count).Column

For x = LC To 1 Step -1

    If Cells(1, x).Value <> "Advisor AO Number" And Cells(1, x).Value <> "Advisor Number" And Cells(1, x).Value <> "Advisor Name" And Cells(1, x).Value <> "Advisor Last Name" And Cells(1, x).Value <> "Weekly Total GDC" And Cells(1, x).Value <> "Weekly Plans" And Cells(1, x).Value <> "Weekly CA's" And Cells(1, x).Value <> "Calendar Year-to-Date Plans" And Cells(1, x).Value <> "Calendar Year-to-Date CA's" And Cells(1, x).Value <> "26 Pd Moving Total GDC" Then
        Columns(x).EntireColumn.Delete
    End If
Next x

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

If it's not Row 1 then change the 1 in this line to match;

If Cells(1, x).Value

HTH

JazzSP8 You are AWESOME!!! You are a genius. That is perfect. Thank you so much. This is unbelievable. Cheers!

 

[JazzSP8]

Careful now, you're going to have me blushing

Thanks for the feedback though, always good to know when you've helped