MS Excel VBA - Delete all columns with blank rows below header 1

[BxWill]

Timely insight needed.

Have a worksheet with 2013 and 2014 in cells C3 and F3, respectively and additional data from cells A4 through H16.

Column headers are in row 4 with columns D and E containing column headers but no data below column headers.

Objective is to create a macro to delete all columns within the used range that have column headers but no data in the column
below the column headers. Note, this will be a recurring daily task.

Any insight as to the modifications needed in the code below to accomplish objective is appreciated.

    Set inputrng = Application.Worksheets("DataCopy").UsedRange
   
    
    Application.ScreenUpdating = False
    For i = inputrng.Columns.Count To 1 Step -1
    Set rngDataCopy = inputrng.Cells(4, i).EntireColumn
    If Application.WorksheetFunction.CountA(rngDataCopy) = 0 Then
    rngDataCopy.Delete
    End If
    Next
    Application.ScreenUpdating = True

 

[BxWill]

Still at it. Revised code, as displayed below but the columns with column headers and blank rows are still not deleted.

 Application.DisplayAlerts = False
        
    With ThisWorkbook.Sheets("DataCopy")
        lcol = .Cells(4, .Columns.Count).End(xlToLeft).Column
        For i = lcol To 1 Step -1
          If Cells(4, i).Offset(1, 0).EntireColumn.Find(What:="*", LookAt:=xlWhole, Searchdirection:=xlPrevious, SearchOrder:=xlByRows).Row = 1 Then _
           Cells(4, i).EntireColumn.Delete
               
        Next i
        
    End With
        
    Application.DisplayAlerts = True

Any insight is appreciated.

 

[SkipVought]

hi,

How about an example?

FYI, I'd use a helper column with a COUNTA() function. Autofilter and select the ZEROS in the helper column then SELECT the rows and DELETE!