Delete multiple columns w/ vba

[ncheever]

Hi,

I need to be able to delete multiple columns based on header content. I would like to incorporate a Msgbox where I can input the values to be found in the headers and then deleted (the whole column).

I have some code (thanks to the contribution of another board member on a different question) and it works great, except I want to incorporate a Msgbox that asks for the values I want to delete.

Sub data_shrnk()
Dim rng As Range

With Worksheets("Dump").Range("A1:CU1")
        Set rng = Worksheets("Dump").Range("A1:CU1").Find(What:="2010", _
            LookAt:=xlPart, MatchCase:=False)
        Do While Not rng Is Nothing
            rng.EntireColumn.Delete
            Set rng = .FindNext
        Loop
    End With

Currently the code will go thru and delete columns with "2010" in the header. I am not sure where/ how to code for the Msgbox especially for multiple values such as: "2006", "2007", "2008", "2009", and "2010".

Can someone help me with this?
Thanks in advance

 

[heifer624]

Sub data_shrnk()
Dim rng As Range
Dim GoBaby As String


GoBaby = Application.InputBox("Enter a year")


With Worksheets("Dump").Range("A1:CU1")
        Set rng = Worksheets("Dump").Range("A1:CU1").Find(What:=GoBaby, _
            LookAt:=xlPart, MatchCase:=False)
        Do While Not rng Is Nothing
            rng.EntireColumn.Delete
            Set rng = .FindNext
        Loop
    End With


End Sub

 

[ncheever]

This is great. However, since I have multiple years to delete, is it possible to code the Msgbox so it comes up again and asks if I have other years to delete before exiting the sub? Thanks

 

[heifer624]

Not pretty, but appears working for me:

Sub data_shrnk()
Dim rng As Range
Dim Enter_Year As String


GoBaby:
Enter_Year = InputBox("Enter Year", "What Years to Delete?")


    If StrPtr(Enter_Year) = 0 Then
     
        Exit Sub
        Else
            If Len(Enter_Year) = 0 Then
    
                msg = MsgBox("Year was NOT entered." & vbCrLf & vbCrLf & "Click the ""OK"" button to try again.", vbCritical)
                GoTo GoBaby
          
            End If
    End If




    With Worksheets("Dump").Range("A1:CU1")
        Set rng = Worksheets("Dump").Range("A1:CU1").Find(What:=Enter_Year, _
            LookAt:=xlPart, MatchCase:=False)
        On Error Resume Next
            rng.EntireColumn.Delete
            'Set rng = .FindNext
        
    End With


GoTo GoBaby:


End Sub