Progressive Count

score,

Sorry, didn't realize those ranges were formulas, not where you enter numbers. I shoulda looked it a little longer. Here's revised code and a modified version of your workbook so you can see how it works:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rngToCheck As Range: Set rngToCheck = Me.Range("G16:K25,O16:S25,G32:K41,O32:S41")
    
    If Not Intersect(rngToCheck, Target) Is Nothing Then
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Dim ChangedSum As Double: ChangedSum = 0
        Dim grp As Range, RowIndex As Integer
        For Each grp In rngToCheck.Areas
            If Not Intersect(Target, grp) Is Nothing Then
                For RowIndex = grp.Row To grp.Row + grp.Rows.Count - 1
                    If Not Intersect(Range(Cells(RowIndex, grp.Column), Cells(RowIndex, grp.Column + grp.Columns.Count - 1)), Target) Is Nothing _
                    And IsNumeric(Cells(RowIndex, grp.Column + grp.Columns.Count).Value) Then
                        ChangedSum = ChangedSum + Cells(RowIndex, grp.Column + grp.Columns.Count).Value
                    End If
                Next RowIndex
            End If
        Next grp
        
        Me.[Y7].Value = Me.[Y7].Value + ChangedSum
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    
    End If
    
End Sub

Hope that helps,
~tigeravatar