Sub AutoSum()
  'https://stackoverflow.com/questions/24047824/vba-excel-loop-assistance
  
  Dim Area As Range, MyColumn As String, startNum As String, SumAddr As String
  Dim i As Long
  Dim c As Range
  Dim cCount As Integer
  
  For i = 2 To 9  'Columns B to E
           
    'loop through area's
    For Each Area In Columns(i).SpecialCells(xlConstants, xlNumbers).Areas
    
        'what area
        Area.Select
            
            'check if sumaddr is empty
            If SumAddr <> "" Then
                'check if area overlaps with previous sum
                If Not Intersect(Area, Range(SumAddr)) Is Nothing Then GoTo Skip
            End If
            
            'Get the start number
            startNum = Area.Resize(1, 1).Address(False, False)
            
                'check if the sum area is only 1 cell
                If Area.Count <= 1 Then GoTo Skip
            
            'Check if the next cell on is a formula
            If Area.Offset(Area.Count, 0).Resize(1, 1).HasFormula = True Then
                               
                    'Loop through cells in area to find the end
                    For Each c In Area.CurrentRegion.Offset(1, 0).Resize(, 1)
                        cCount = cCount + 1
                        
                        If c.Value = "" Then
                            SumAddr = Range(startNum).Offset(1, 0).Resize(cCount - 1, 1).Address
                            'SumAddr = Area.CurrentRegion.Offset(1, 0).Resize(cCount - 1, 1).Address
                                                                              
                            Range(SumAddr).Select
                        
                            Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Select
                        
                            Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Formula = "=" & startNum & "-SUM(" & SumAddr & ")"
                            Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Font.Color = vbRed
                        
                        GoTo Skip
                    
                End If
                    
                    Next c
            
            Else: SumAddr = Area.Offset(1, 0).Resize(Area.Count - 1, 1).Address(False, False)
            
        End If

    Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=" & startNum & "-SUM(" & SumAddr & ")"
    Area.Offset(Area.Count, 0).Resize(1, 1).Font.Color = vbRed

Skip:

    cCount = 0
    
   Next Area
  
  Next i
End Sub