Remove Empty Rows and Columns

Sub RemoveEmptyRowsAndColumns()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' Remove empty rows (from bottom to top)
    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
            ws.Rows(i).Delete
        End If
    Next i

    ' Remove empty columns (from right to left)
    For j = lastCol To 1 Step -1
        If Application.WorksheetFunction.CountA(ws.Columns(j)) = 0 Then
            ws.Columns(j).Delete
        End If
    Next j

    MsgBox "Empty rows and columns removed!"
End Sub