Untitled
Sub FilterAndRemoveBlankRows() Dim wsReport As Worksheet Dim lastRow As Long Dim i As Long Dim countryColumns As Variant Dim col As Long Dim isRowEmpty As Boolean ' Set your report worksheet Set wsReport = ThisWorkbook.Sheets("Report Sheet") ' Change "Report Sheet" to your destination sheet name ' Define the columns for each country (2-column sets for each country) countryColumns = Array(Array(5, 6), Array(9, 9), Array(10, 11), Array(12, 12), _ Array(13, 13), Array(14, 15), Array(16, 17), Array(18, 19), Array(20, 21)) ' Find the last row in the report sheet lastRow = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row ' Loop through rows from the bottom to the top For i = lastRow To 4 Step -1 ' Data starts from row 4 isRowEmpty = True ' Check each country column pair for non-blank data For Each col In countryColumns ' Check if at least one of the two columns for the current country contains data If wsReport.Cells(i, col(0)).Value <> "" Or wsReport.Cells(i, col(1)).Value <> "" Then isRowEmpty = False Exit For End If Next col ' If the row is empty in all checked columns, delete it If isRowEmpty Then wsReport.Rows(i).Delete End If Next i End Sub
Leave a Comment