Excel macro to populate whole column terminating at blank row and not proceeding to cells below

Question

I have an Excel workbook with a Sheet that has some colored cells. I have a vba script/macro to calculate the total of number of these cells in each row and do some further manipulation then populate the resulting value in column A. The problem is I have some blank rows between some data rows. So when I run the macro, it only populates the 'AT' column for the for the first data range before the blank rows. I need it to go past this and all the way down. I am having trouble accomplishing this.

This is my current script:

Sub CountCellsByColor()
    Dim targetSheet As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim fillColor As Long
    Dim cellCount As Long, totalMinutes As Long
    Dim hours As Long, minutes As Long
    
    ' Specify the sheet
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' Find the last row with data in column C
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row
    
    ' Define the fill color to count
    fillColor = 9359529
    
    ' Loop through each row
    For i = 1 To lastRow
        cellCount = 0 ' Reset cell count for each row
        
        ' Loop through each column from C to AR
        For j = 3 To 44 ' Column C corresponds to column index 3, Column AR corresponds to column index 44
            ' Check if the cell's fill color matches the specified color
            If targetSheet.Cells(i, j).Interior.Color = fillColor Then
                cellCount = cellCount + 1 ' Increment the cell count
            End If
        Next j
        
        ' Calculate total minutes
        totalMinutes = cellCount * 15
        
        ' Convert total minutes into hours and minutes
        hours = totalMinutes \ 60
        minutes = totalMinutes Mod 60
        
        ' Insert the duration in "HH:MM" format in column AT of the current row
        If cellCount > 0 Then
            targetSheet.Cells(i, 46).Value = Format(hours, "00") & ":" & Format(minutes, "00") ' Column AT corresponds to column index 46
        Else
            targetSheet.Cells(i, 46).Value = "" ' Leave the cell empty if count is zero
        End If
    Next i
End Sub

I suspect the issue is somewhere on this line:

lastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row

and more specifically this End(xlUp) but I have tried playing with it to see what may work and I cannot come up with a working solution. I could and am most probably wrong.

Any assistance would be greatly appreciated.

EDIT Here is a link to the file I am working with. I have tried some of the suggested comments so figured it might be best to attach the file since they are not working.

LINK: https://drive.google.com/file/d/1jOHKFvVoMa7NpSdG8I846sVVDFiy25X8/view?usp=sharing

Answer 1

You can check for the last-used row on the sheet, regardless of column:

Sub CountCellsByColor()
    Const FILLCOLOR As Long = 9359529
    
    Dim targetSheet As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim cellCount As Long
    
    
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' Find the last row with data on `targetSheet`
    lastRow = LastOccupiedRow(targetSheet)
    
    For i = 1 To lastRow
        cellCount = 0
        For j = 3 To 44
            If targetSheet.Cells(i, j).Interior.COLOR = FILLCOLOR Then
                cellCount = cellCount + 1 ' Increment the cell count
            End If
        Next j
        targetSheet.Cells(i, 46).Value = IIf(cellCount = 0, "", _
                                 Format(cellCount * 15 / 1440, "hh:mm"))
    Next i
End Sub

Function LastOccupiedRow(ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not f Is Nothing Then LastOccupiedRow = f.Row
End Function

FYI you can do something similar with a small UDF:

Function CountColor(rng As Range) As Long
    Application.Volatile
    Dim c As Range
    For Each c In rng.Cells
        If c.Interior.Color = 9359529 Then CountColor = CountColor + 1
    Next c
End Function

...and a worksheet function:

=LET(num,countcolor(C20:AR20),IF(num=0,"",num*15/1440))

(format cells with the formula as "hh:mm")