Delete Columns With Blank Headers VBA - excel

Question

I am looking for assistance in deleting two columns within my range of data that have blank headers. These blank headers will appear in the first row of my used range. What would be the best way to go about this? Should I use .Find to search for blank cells in the first row and then get the column address of the two blank cells in order to delete them?
Currently, I am just deleting the columns that I know they'll appear in, but this has the potential to change. Current code:
rngUsed.Columns("F").Delete
rngUsed.Columns("H").Delete
Because the data can change, what would be the better way of handling this?
Thanks!

Answer 1

You can use SpecialCells to find the blanks in the first row and remove the corresponding columns:
Dim rng As Range
Set rng = Range("B3").CurrentRegion 'for example...
On Error Resume Next 'ignore error if no blanks
rng.Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
On Error GoTo 0 'stop ignoring errors

Answer 2

Delete Columns With Blank Headers
The current setup is in Test Mode i.e. it will select the columns to be deleted. If the result is satisfactory, switch to Const TestMode As Boolean = False when the columns will be deleted.
Adjust the values in the constant sections.
The Code
Option Explicit
Sub TESTdeleteBlankHeadered()
Const wsName As String = "Sheet1"
Const ColumnsCount As Long = 2 ' -1 - all columns containing blank headers.
Dim wb As Workbook: Set wb = ThisWorkbook
Dim rg As Range: Set rg = wb.Worksheets(wsName).UsedRange
deleteBlankHeadered rg, ColumnsCount ' first found columns
'deleteBlankHeadered rg, ColumnsCount, True ' last found columns
'deleteBlankHeadered rg ' all found columns
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a worksheet, deletes a specified number of its columns,
' defined by blank cells in the first (header) row of
' a given range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub deleteBlankHeadered( _
rg As Range, _
Optional ByVal ColumnsCount As Long = -1, _
Optional ByVal LastOccurringColumns As Boolean = False)
' When 'True', tests with select.
' When 'False', deletes.
Const TestMode As Boolean = True
' Validate inputs.
If rg Is Nothing Then Exit Sub
If ColumnsCount < -1 Or ColumnsCount = 0 Then Exit Sub
' Define Source Row Range.
Dim srg As Range: Set srg = rg.Areas(1).Rows(1)
' Write values from Source Row Range to Data Array.
Dim cCount As Long: cCount = srg.Columns.Count
Dim Data As Variant
If cCount > 1 Then
Data = srg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
End If
' Define 'elements' of the 'For...Next' Loop.
Dim cFirst As Long, cLast As Long, cStep As Long
If LastOccurringColumns Then
cFirst = cCount: cLast = 1: cStep = -1
Else
cFirst = 1: cLast = cCount: cStep = 1
End If
' Declare additional variables.
Dim drg As Range ' Delete Range
Dim oCount As Long ' Occurrences Count
Dim j As Long ' Data Array (Source Row Range) Columns Counter
' Loop through columns of Data Array and use found blank values
' to combine blank cells with Delete Range.
For j = cFirst To cLast Step cStep
If Not IsError(Data(1, j)) Then
If Len(Data(1, j)) = 0 Then
oCount = oCount + 1
Select Case oCount
Case 1
Set drg = srg.Cells(j)
If ColumnsCount = 1 Then
Exit For
End If
Case ColumnsCount
Set drg = Union(drg, srg.Cells(j))
Exit For
Case Else
Set drg = Union(drg, srg.Cells(j))
End Select
End If
End If
Next
' Declare additional variables.
Dim ActionTaken As Boolean
' Delete Column Ranges (containing blank headers).
If Not drg Is Nothing Then
Application.ScreenUpdating = False
If TestMode Then
drg.Worksheet.Activate
drg.EntireColumn.Select
Else
drg.EntireColumn.Delete
End If
Application.ScreenUpdating = True
ActionTaken = True
End If
' Inform user.
If ActionTaken Then
MsgBox "Columns deleted: " & oCount, vbInformation, "Success"
Else
MsgBox "No columns deleted.", vbExclamation, "No Action Taken"
End If
End Sub