Excel VBA - Delete empty columns between two used ranges

Question

I would like to delete all empty columns between 2 used ranges, based on the screenshot:

However, these two used ranges may have varying column length, thus the empty columns are not always Columns D to K.

Here is my code:

Sub MyColumns()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open ("BOOK2.xlsx")
Workbooks("BOOK2.xlsx").Activate
Workbooks("BOOK2.xlsx").Sheets(1).Activate

Workbooks("BOOK2.xlsx").Sheets(1).Cells(1, 4).Value = "NON-EMPTY"

Dim finalfilledcolumn As Long
finalfilledcolumn = Workbooks("BOOK2.xlsx").Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

Dim iCol As Long
Dim i As Long

iCol = firstfilledcolumn + 1

'Loop to delete empty columns

For i = 1 To firstfilledcolumn + 1
    Columns(iCol).EntireColumn.Delete
Next i

Workbooks("BOOK2.xlsx").Close SaveChanges:=True

MsgBox "DONE!"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

However, the empty columns still remain.

Do note that the last filled column for the first used range, Place = "USA", Price = "110" and Category = "Mechanical" may not be fixed at Column C, but could go to Column D, E, etc.

Many thanks!

Answer 1

Please, try the next way:

Sub deleteEmptyColumn()
   Dim sh As Worksheet, lastCol As Long, rngColDel As Range, i As Long
   
   Set sh = ActiveSheet 'use here your necessary sheet, having the workbook open
                        'if not open, you can handle this part...
   lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).column
   For i = 1 To lastCol
     If WorksheetFunction.CountA(sh.Columns(i)) = 0 Then
        If rngColDel Is Nothing Then
            Set rngColDel = sh.cells(1, i)
        Else
           Set rngColDel = Union(rngColDel, sh.cells(1, i))
        End If
     End If
   Next i
   If Not rngColDel Is Nothing Then rngColDel.EntireColumn.Delete
End Sub

Answer 2

Try this..

Dim rng As Range, i As Long
Set rng = Workbooks("BOOK2.xlsx").Sheets(1).UsedRange
For i = rng.Columns.Count To 1 Step -1
If WorksheetFunction.CountA(rng.Columns(i)) = 0 Then
rng.Columns(i).EntireColumn.Delete
End If
Next i