Deleting all columns except columns with certain headings

Question

I am trying to format exported data and need to delete several columns. I want to keep columns with certain headings. For convenience if I have 15 columns and want to keep c

Answer 1

Try this one.

Iterate over the columns in reverse order, check the headers in a Select Case, and delete as needed.

Sub deleteIrrelevantColumns()
    Dim currentColumn As Integer
    Dim columnHeading As String

    ActiveSheet.Columns("L").Delete

    For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1

        columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

        'CHECK WHETHER TO KEEP THE COLUMN
        Select Case columnHeading
            Case "State", "City", "Name", "Client", "Product"
                'Do nothing
            Case Else
                'Delete if the cell doesn't contain "Homer"
                If Instr(1, _
                   ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
                   "Homer",vbBinaryCompare) = 0 Then

                    ActiveSheet.Columns(currentColumn).Delete

                End If
        End Select
    Next

End Sub

Answer 2

I'm guessing we're talking Excel here. If so iterating through your columns with a while loop and deciding to keep or not to keep should do the trick.

Sub deleteIrrelevantColumns()
    Dim keepColumn As Boolean
    Dim currentColumn As Integer
    Dim columnHeading As String

    currentColumn = 1
    While currentColumn <= ActiveSheet.UsedRange.Columns.Count
        columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

        'CHECK WHETHER TO KEEP THE COLUMN
        keepColumn = False
        If columnHeading = "State" Then keepColumn = True
        If columnHeading = "City" Then keepColumn = True
        If columnHeading = "Name" Then keepColumn = True
        If columnHeading = "Client" Then keepColumn = True
        If columnHeading = "Product" Then keepColumn = True


        If keepColumn Then
        'IF YES THEN SKIP TO THE NEXT COLUMN,
            currentColumn = currentColumn + 1
        Else
        'IF NO DELETE THE COLUMN
            ActiveSheet.Columns(currentColumn).Delete
        End If

        'LASTLY AN ESCAPE IN CASE THE SHEET HAS NO COLUMNS LEFT
        If (ActiveSheet.UsedRange.Address = "$A$1") And (ActiveSheet.Range("$A$1").Text = "") Then Exit Sub
    Wend

End Sub

Answer 3

I had a similar problem and this is the code that worked for me. I think it is much simpler.

Range("A1").Select

Do Until ActiveCell.Value = ""

    If ActiveCell.Value = "Forecast Status" _
        Or ActiveCell.Value = "Amount " _
        Or ActiveCell.Value = "Service Booking Value " _
        Or ActiveCell.Value = "Transaction Number" _
        Or ActiveCell.Value = "Last Modified by" _
        Or ActiveCell.Value = "Last Modified Date" _
        Or ActiveCell.Value = "T# Comparison" _
        Or ActiveCell.Value = "Amount Comparison" _
        Or ActiveCell.Value = "Forecast Status Comparison" _
        Or ActiveCell.Value = "First Ship Date Comparison" Then

        ActiveCell.Offset(0, 1).Select

    Else

        ActiveCell.EntireColumn.Select
        Selection.Delete Shift:=xlToLeft
        Selection.End(xlUp).Select

    End If
Loop