Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Date
- Name
- Amount Owing
- Balance
- 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
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement