Defca Trick
Defca Trick

Reputation: 315

Excel VBA to Remove Columns Based on Multiple Headers on Multiple Sheets

Would the below code be able to be modified to 1 loop through all sheets in a workbook and 2 remove multiple columns based on their headers?

example: "status","Status Name","Status Processes" etc.)? And then cycle through all sheets in the wkbk to do the same checks?

Sub remove_columns()
    For i = ActiveSheet.Columns.Count To 1 Step -1
        If InStr(1, Cells(1, i), "Status") Then Columns(i).EntireColumn.Delete
    Next i
End Sub

Upvotes: 3

Views: 3752

Answers (3)

R3uK
R3uK

Reputation: 14537

You need to properly reference the sheet, easy using With and you can use LCase() to avoid case sensitivity :

Sub remove_columns()
    Dim wS As WorkSheet
    For Each wS in ThisWorkbook.Worksheets
        With wS
            For i = .Columns.Count To 1 Step -1
                If InStr(1, LCase(.Cells(1, i)), LCase("Status")) Then _
                    .Columns(i).EntireColumn.Delete
            Next i
        End With 'wS
    Next wS
End Sub

Upvotes: 1

user4039065
user4039065

Reputation:

dim a as long, w as long, vDELCOLs as variant, vCOLNDX as variant
vdelcols = array("status","Status Name","Status Processes")
with thisworkbook
    for w=1 to .worksheets.count
        with worksheets(w)
            for a=lbound(vdelcols) to ubound(vdelcols)
                vcolndx=application.match(vdelcols(a), .rows(1), 0)
                if not iserror(vcolndx) then
                    .columns(vcolndx).entirecolumn.delete
                end if
            next a
        end with
    next w
end with

You obviously have less columns to delete than columns that exist. Look for matches to the columns to delete rather than comparing every column to the delete list.

This looks (case-insensitive) for the column names in row 1.

Upvotes: 3

user3598756
user3598756

Reputation: 29421

I'd go like follows

Sub Main()
    Dim sh As Worksheet
    Dim i as Long

    For Each sh In ThisWorkbook.Sheets
        With sh.UsedRange
            For i = .columns.Count To 1 Step -1
                If InStr(1, LCase(.columns(i).cells(1)), "status") Then .columns(i).EntireColumn.Delete
            Next
        End With
    Next
End Sub

Upvotes: 2

Related Questions