Selecting multiple columns by their header name for deletion using VBA-CodePudding

I'm creating a VBA script which will delete a lot of blank columns from a downloaded excel file. As the total number of columns are likely to change over time, I can't just use the cell reference as any changes would knock the macro out of sync (like it has already). Now, I want to target the columns by their column header, as not their cell reference. So, I've collated a complete list of columns I want to delete (there are a lot) and added them to the VBA module with the correct syntax surrounding them ("@", & _)

I'm quite new to using VBA and I've not found much online that is much use. I found the below script which does a good job of deleting a single column.

Sub FindAddressColumn()
'Updateby Extendoffcie
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "Name"
    Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Select
End Sub**

But when I tried making amendments to include a range of column headers I am hit with an error message - 'Compile Error: Wrong number of arguments or invalid property assignment'

Sub deleteEmptyCols()
'Updateby Extendoffcie
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = Range("PREVIOUS TRANSACTION ID", "PARENT TRANSACTION ID", "TRANSACTION COMMENTS", "HP INVOICE NUMBER", "REPORTER PURCHASE ORDER ID", "PARTNER PURCHASE PRICE", "CUSTOMER TO CHANNEL PARTNER PURCHASE ORDER ID", "PARTNER INTERNAL TRANSACTION ID", "PARTNER REQUESTED REBATE AMOUNT", "PARTNER COMMENT", "DEAL/PROMO ID #2", "DEAL/PROMO ID #3", "DEAL/PROMO ID #4", "DEAL/PROMO ID #5", "DEAL/PROMO ID #6", "DEAL BUNDLE ID #1", "REBATE DEAL 1 MINIMUM RESELLER QUANTITY", "REBATE DEAL 1 MAX RESELLER QUANTITY", "EXTENDED REFERENCE PRICE (SNOP) 1", "DEAL BUNDLE ID #2" & _
    "REBATE DEAL 2", "REBATE DEAL 2 START DATE", "REBATE DEAL 2 END DATE", "REBATE DEAL 2 MC CODE", "REBATE DEAL 2 MINIMUM RESELLER QUANTITY", "REBATE DEAL 2 MAX RESELLER QUANTITY", "REBATE DEAL 2 DEAL VERSION", "REBATE DEAL 2 REMAINING QTY", "BACKEND DEAL DISCOUNT TYPE BASE 2", "BACKEND DEAL REBATE AMOUNT PER UNIT TOTAL 2", "BACKEND DEAL NET TOTAL 2", "DCT FLAG DEAL 2", "EXTENDED REFERENCE PRICE (SNOP) 2", "DEAL BUNDLE ID #3", "REBATE DEAL 3", "REBATE DEAL 3 START DATE", "REBATE DEAL 3 END DATE", "REBATE DEAL 3 MC CODE", "REBATE DEAL 3 MINIMUM RESELLER QUANTITY", "REBATE DEAL 3 MAX RESELLER QUANTITY" & _
"REBATE DEAL 3 DEAL VERSION", "REBATE DEAL 3 REMAINING QTY", "BACKEND DEAL DISCOUNT TYPE BASE 3", "BACKEND DEAL REBATE AMOUNT PER UNIT TOTAL 3", "BACKEND DEAL NET TOTAL 3", "DCT FLAG DEAL 3", "EXTENDED REFERENCE PRICE (SNOP) 3", "DEAL BUNDLE ID #4", "REBATE DEAL 4", "REBATE DEAL 4 START DATE", "REBATE DEAL 4 END DATE", "REBATE DEAL 4 MC CODE", "REBATE DEAL 4 MINIMUM RESELLER QUANTITY", "REBATE DEAL 4 MAX RESELLER QUANTITY", "REBATE DEAL 4 DEAL VERSION", "REBATE DEAL 4 REMAINING QTY", "BACKEND DEAL DISCOUNT TYPE BASE 4", "BACKEND DEAL REBATE AMOUNT PER UNIT TOTAL 4", "EXTENDED REFERENCE PRICE (SNOP) 4", "BACKEND DEAL NET TOTAL 4" & _
"DCT FLAG DEAL 4", "DEAL BUNDLE ID #5", "REBATE DEAL 5", "REBATE DEAL 5 START DATE", "REBATE DEAL 5 END DATE", "REBATE DEAL 5 MC CODE", "REBATE DEAL 5 MINIMUM RESELLER QUANTITY", "REBATE DEAL 5 MAX RESELLER QUANTITY", "REBATE DEAL 5 DEAL VERSION", "REBATE DEAL 5 REMAINING QTY", "BACKEND DEAL DISCOUNT TYPE BASE 5", "BACKEND DEAL REBATE AMOUNT PER UNIT TOTAL 5", "BACKEND DEAL NET TOTAL 5", "DCT FLAG DEAL 5", "EXTENDED REFERENCE PRICE (SNOP) 5", "DEAL BUNDLE ID #6", "PARTNER REPORTED CBN#", "PARTNER REFERENCE", "INTERCOMPANY FLAG", "SOLD TO STATE" & _
"END USER CUSTOMER NAME", "END USER ID", "UPFRONT DEAL ID", "SUB REGION PARTNER LOCATOR NUMBER", "WW PARTNER LOCATOR NUMBER", "CUSTOMER ID", "EXTENDED SHIPMENT PRICE", "DERIVED INVOICE PRICE", "REBATE ADJUSTMENT", "ELIGIBLE SALES ADJUSTMENT", "IS MAXCAP MET", "BUNDLE COMPLETENESS STATUS", "IS MINCAP MET", "CREDIT MEMO DATE", "CREDIT MEMO REFERENCE", "PAID QUANTITY", "PAID AMOUNT", "PAID COMMENTS", "DNQ", "STACKING VALIDATION" & _
"ADJUSTMENT COMMENTS", "REVERSAL PAYMENT REFERENCE", "FCM PRICING REBATE FLAG", "CASE NUMBER", "CASE STATUS", "CASE LAST STATUS UPDATE DATE", "CASE CREATION DATE", "CASE COMMENT", "REASON CODE", "REASON DESCRIPTION", "PRICE POINT WARNING DETAILS")

    Set xRg = Range("A1:GO1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Select
End Sub
```

All I expect to happen is select all of the columns mentioned in the range, and then be able to delete them all using the macro.

CodePudding user response：

Instead of hardcoding your column headers, why not check if the column is empty and delete if true?

Sub deleteEmptyColumns()
    Dim lastColumn As Long
    lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = lastColumn To 1 Step -1
        If WorksheetFunction.CountA(ActiveSheet.Columns(i)) <= 1 Then ActiveSheet.Columns(i).EntireColumn.Delete
    Next
    
End Sub

Hope that'll be fine without selecting them ;)

CodePudding user response：

Here's a clean procedure to loop through your top row and delete values that are in your array list. If you wanted to keep the members in the list, then just move the delete range to the other side of the if statement.

Sub removeColumns()

Dim zRay()
zRay = Array("PREVIOUS TRANSACTION ID", "PARENT TRANSACTION ID", "TRANSACTION COMMENTS")


Dim i As Long, killRange As Range, testZone As Range, ws As Worksheet, acell As Range

Set ws = ActiveSheet 'or whatever sheet you're looking at

'dynmaic range of all active values in row 1
Set testZone = Intersect(ws.UsedRange, ws.Rows(1))


For Each acell In testZone.Cells
    'loops through above array values looking for exact match
    For i = LBound(zRay) To UBound(zRay)
        If zRay(i) = acell.Value Then
            'delete it?
            If killRange Is Nothing Then
                Set killRange = acell.EntireColumn
            Else
                Set killRange = Union(acell.EntireColumn, killRange)
            End If
            Exit For
        Else
            'keep it?
            
        End If
    Next i
    
Next acell

If Not killRange Is Nothing Then
    killRange.Delete
End If

End Sub