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