3

I want to delete all columns in all worksheets of an Excel workbook except those named:

Date
Name
Amount Owing
Balance

The following code is working in the active worksheet:

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

For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
    columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

'Check whether to preserve the column
    Select Case columnHeading
    'Insert name of columns to preserve
        Case "Date", "Name", "Amount Owing", "Balance"
            'Do nothing
        Case Else
            'Delete the column
            ActiveSheet.Columns(currentColumn).Delete
        End Select
    Next
End Sub

How can I modify this code to apply on all worksheets?

Community
  • 1
  • 1
  • You will need to [loop through each worksheet](https://stackoverflow.com/questions/25953916/excel-vba-looping-through-multiple-worksheets#25953980) – cybernetic.nomad May 24 '18 at 17:36

1 Answers1

3

Something like this is what you're looking for:

Sub DeleteSelectedColumns()

    Dim ws As Worksheet
    Dim rDel As Range
    Dim HeaderCell As Range
    Dim sKeepHeaders As String
    Dim sDelimiter as String

    sDelmiter = ":"
    sKeepHeaders = Join(Array("Date", "Name", "Amount Owing", "Balance"), sDelimiter)

    For Each ws In ActiveWorkbook.Sheets
        Set rDel = Nothing
        For Each HeaderCell In ws.Range("A1", ws.Cells(1, ws.Columns.Count).End(xlToLeft)).Cells
            If InStr(1, sDelimiter & sKeepHeaders & sDelimiter, sDelimiter & HeaderCell.Value & sDelimiter, vbTextCompare) = 0 Then
                If Not rDel Is Nothing Then Set rDel = Union(rDel, HeaderCell) Else Set rDel = HeaderCell
            End If
        Next HeaderCell
        If Not rDel Is Nothing Then rDel.EntireColumn.Delete
    Next ws

End Sub
tigeravatar
  • 26,199
  • 5
  • 30
  • 38
  • What about sheet name containing comma? – JohnyL May 24 '18 at 20:00
  • @JohnyL While I highly recommend that sheetnames not contains commas, you could change the delimiter to a colon `:` because sheet names cannot contain colons. – tigeravatar May 24 '18 at 20:01
  • I guess it should be noted in your answer or change delimiter to colon. – JohnyL May 24 '18 at 20:03
  • @JohnyL It should also be noted that even if the sheet name contained a comma, the code would still have run successfully. It doesn't look at sheetnames when evaluating the header cell values. – tigeravatar May 24 '18 at 20:06
  • *could would still have run successfully* Well, I didn't *insist* it won't work - I just asked *whether* it will work. :) – JohnyL May 24 '18 at 20:07
  • Thank you for your help, this is working perfectly :) –  May 25 '18 at 01:09