VBA Sum Dynamic Range

Hello rlsublime,

This change should solve the problem. Here is the updated code in its entirety. As before, the change appears in red font.

Sub SumRows()

    Dim DateCell As Range
    Dim DstRng As Range
    Dim LastCol As Long
    Dim r As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Row As Range
    Dim SumRng As Range
    Dim Wks As Worksheet
    
         Set Wks = Worksheets("Sheet1")
         
         Set Rng = Wks.Range("D2")
         
       ' Cell where the first sum will be copied to.
         Set DstRng = Wks.Range("B3")
         
       ' Find the last cell with data.
         Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
         
       ' Check there is data on the worksheet.
         If RngEnd.Row < Rng.Row Then Exit Sub
         
       ' Expand the range to the last row.
         Set Rng = Wks.Range(Rng, RngEnd)
         
       ' Find the last column with a header.
         LastCol = Wks.Cells(2, Columns.Count).End(xlToLeft).Column
         
       ' Check there is data.
         If LastCol <= Rng.Column Then Exit Sub
         
         Set Rng = Rng.Resize(ColumnSize:=LastCol - Rng.Column + 1)
         
          ' Setup to search for dates.
            With Application.FindFormat
                .Clear
                .NumberFormat = "m/d/yyyy"
            End With
            
          ' Find the First Date.
            Set DateCell = Rng.Rows(1).Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlNext, False, False, True)
            If Not DateCell Is Nothing Then FirstAddx = DateCell.Address Else Exit Sub
        
          ' The sum range is all cells with dates for column headers.
            Do While Not DateCell Is Nothing
                c = c + 1
                Set DateCell = Rng.Rows(1).Cells.Find("*", DateCell, xlValues, xlWhole, xlByColumns, xlNext, False, False, True)
                If DateCell.Address = FirstAddx Then Exit Do
            Loop
            
              ' Start 1 one row below the column headers.
                Set SumRng = DateCell.Offset(1, 0).Resize(Rng.Rows.Count - 1, c)
            
                LastCol = SumRng.Columns(SumRng.Columns.Count).Column
                
                For Each Row In SumRng.Rows
                    On Error Resume Next
                      ' Find the first non empty cell in the row.
                        c = Row.Find("*", Row.Cells(1, 1), xlValues, xlWhole, xlByColumns, xlNext, False).Column
                        
                      ' If the row is empty then an error will occur.
                        If Err = 0 Then
                          ' Find the cell to the right of the first non empty cell to the end of cells to be summed.
                            Set Row = Intersect(Row, Range(Columns(c + 1), Columns(LastCol)))
                            
                          ' Sum the cells in the row and copy the sum to column "B".
                            If Not Row Is Nothing Then DstRng.Offset(r, 0) = Application.Sum(Row)
                            r = r + 1
                        End If
                    On Error GoTo 0
                Next Row
            
End Sub

Hello rlsublime,

AAAHHHHH! I can't believe I forgot to exclude the first column dynamically! Here is the change to the If statement to ignore the first column in the Sum Range.

                          ' Find the cell to the right of the first non empty cell to the end of cells to be summed.
                            If c = SumRng.Column + 1 Then
                                Set Row = Intersect(Row, Range(Columns(c), Columns(LastCol)))
                            Else
                                Set Row = Intersect(Row, Range(Columns(c + 1)), Columns(LastCol))
                            End If

Sub hsv_2()
Dim i As Long, c As Range
 With Sheets(1)
  For i = 3 To .Cells(Rows.Count, 4).End(xlUp).Row - 1
   Set c = .Range(.Cells(i, 4), .Cells(i, Columns.Count)).Find("*")
     If c.Column > 4 Then
  Sheets(2).Cells(i, 1) = c
     End If
   Next i
 End With
  With Sheets(2)
    .Cells(Rows.Count, 1).End(xlUp).Offset(1) = WorksheetFunction.Sum(.Columns(1))
  End With
End Sub