Untitled

Sub FilterAndRemoveBlankRows()

    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim countriesColumns As Variant
    Dim countryCol As Variant

    ' Set your report worksheet
    Set wsReport = ThisWorkbook.Sheets("Report Sheet") ' Change "Report Sheet" to your destination sheet name

    ' Define the columns for the countries (E:H for UAE, I for Hong Kong, etc.)
    countriesColumns = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U")

    ' Find the last row in the Report Sheet (based on column A)
    lastRow = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row

    ' Loop through rows from the bottom to the top to delete blank rows
    For i = lastRow To 4 Step -1 ' Start from row 4
        Dim rowHasData As Boolean
        rowHasData = False

        ' Check if there is any data in the specified country columns for the current row
        For Each countryCol In countriesColumns
            If wsReport.Cells(i, countryCol).Value <> "" Then
                rowHasData = True
                Exit For ' Stop checking further columns if data is found
            End If
        Next countryCol

        ' If no data found in the country columns, delete the row
        If Not rowHasData Then
            wsReport.Rows(i).Delete
        End If
    Next i

End Sub