VBA - Remove certain rows where after certain columns are empty - excel

Question

I have a excel table looks like below:
Name task date1 date2 date3 date4
John t1 d1
Lucy t2
Mary t3 d2 d3
I want to remove the rows whose columns after 3rd column (i.e. from date1) are empty (e.g. Lucy in this example)
I found the below example, I think it is close but not sure how I can modify it by choosing the empty rows after 3rd column instead of the whole row.
Sub DeleteAllEmptyRows()
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range
Set UsedRng = ActiveSheet.UsedRange
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False
For RowIndex = LastRowIndex To 1 Step -1
If Application.CountA(Rows(RowIndex)) = 0 Then 'Some logic to add here to choose range
Rows(RowIndex).Delete
End If
Next RowIndex
Application.ScreenUpdating = True
End Sub
Any suggestions please? Thanks.

Answer 1

I think all you need is to first calculate the last column in the used range and then use it in the CountA statement inside the loop.
To calculate the last column, you could add the following lines right before the loop:
Dim LastColIndex As Integer: LastColIndex = UsedRng.Column - 1 + UsedRng.Columns.Count
The If statement would then need to look like something like this:
If WorksheetFunction.CountA(Range(Cells(RowIndex, 3), Cells(RowIndex, LastColIndex))) = 0 Then
This checks for non-empty values starting from the 3rd column in the current row.
The combined code would then look like this:
Sub DeleteAllEmptyRows()
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range
Set UsedRng = ActiveSheet.UsedRange
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False
Dim LastColIndex As Integer: LastColIndex = UsedRng.Column - 1 + UsedRng.Columns.Count
For RowIndex = LastRowIndex To 1 Step -1
If WorksheetFunction.CountA(Range(Cells(RowIndex, 3), Cells(RowIndex, LastColIndex))) = 0 Then
Rows(RowIndex).Delete
End If
Next RowIndex
Application.ScreenUpdating = True
End Sub
I would also change the For loop to count down to 2 instead of 1 to avoid the possibility of ever deleting the header row, but I guess that depends on your taste :)
In case of phantom values ...
Sometimes, cells have values that are invisible to the naked eye but are counted by Excel's COUNTA function, as when a cell has one or more spaces as its value. If those cases need to be accounted for, we can check each cell individually using the following VBA function:
Function IsBlankRange(ByRef rng As Range) As Boolean
'For faster processing, read in the entire range into a memory variable
' instead of reading in each cell value from Excel
Dim arr As Variant: arr = rng.Value
'If the range contains a single value, check it and exit
If Not IsArray(arr) Then 'With single-value ranges, arr will not be an array
IsBlankRange = Trim(arr & "") = ""
Exit Function
End If
'If we are here, the range contains an array of values,
' so we must loop through the array
'Assume the range is not blank
IsBlankRange = False
Dim arrLb1 As Long: arrLb1 = LBound(arr, 1)
Dim arrUb1 As Long: arrUb1 = UBound(arr, 1)
Dim arrLb2 As Long: arrLb2 = LBound(arr, 2)
Dim arrUb2 As Long: arrUb2 = UBound(arr, 2)
Dim i As Long, j As Long
For i = arrLb1 To arrUb1
For j = arrLb2 To arrUb2
'Return false (the value assumed above) on the first non-blank value
If Trim(arr(i, j) & "") <> "" Then Exit Function
Next
Next
'If we are here, no non-blank value was encountered, so the range is blank
IsBlankRange = True
End Function
This function can be used to change the If WorksheetFunction.CountA(...) = 0 line to
If IsBlankRange(Range(Cells(RowIndex, 3), Cells(RowIndex, LastColIndex))) Then
In short, the new procedure would look like this:
Sub DeleteAllEmptyRows()
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range
Set UsedRng = ActiveSheet.UsedRange
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False
Dim LastColIndex As Integer: LastColIndex = UsedRng.Column - 1 + UsedRng.Columns.Count
For RowIndex = LastRowIndex To 1 Step -1
If IsBlankRange(Range(Cells(RowIndex, 3), Cells(RowIndex, LastColIndex))) Then
Rows(RowIndex).Delete
End If
Next RowIndex
Application.ScreenUpdating = True
End Sub
Naturally, the new IsBlankRange function would need to be added as well (below the DeleteAllEmptyRows code, probably). The function can be made private to the module if it will never be used anywhere else.
But, if you can use CONCAT ...
The IsBlankRange function can be simplified if you have Excel 2019 and can use the new CONCAT function, which can be applied to a range:
Function IsBlankRange(ByRef rng As Range) As Boolean
IsBlankRange = Trim(WorksheetFunction.Concat(rng) & "") = ""
End Function
{The CONCAT function is explained at https://www.excelfunctions.net/excel-concat-function.html}
Instead of using an IsBlankRange function, CONCAT could also be used directly in the If statement inside the For loop:
If Trim(WorksheetFunction.Concat(Range(Cells(RowIndex, 3), Cells(RowIndex, LastColIndex))) & "") = "" Then
However, I believe that leaving the range evaluation in a separate function makes it easier to customise depending on the version of Excel being used, and it makes the If statement easier to read.