VBS Summing

[luke6843]

I am using the following code:

Dim r As Long
For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
If Range("H" & r).Value <> Range("H" & r - 1) Then
Rows(r).Insert
Rows(r).Insert
End If
Next r
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row + 1
    If IsEmpty(Range("a" & r).Value) Then
        Range("A" & r).Value = "Total"
        MY_END = Range("A" & r - 1).Row
        MY_START = Range("A" & r - 1).End(xlUp).Row
        If MY_START = 1 Then MY_START = 2
        Range("F" & r).Formula = "=sum(F" & MY_START & ":F" & MY_END & ")"
        Range("F" & r).Copy Range("G" & r)
        r = r + 1
    End If
Next r

The result is as follows:
48 960
126 2520
174 3480 Total

56 1680
230 5160 Total

500 10,000
730 15160 Total

The problem is the totals are adding up the above lines if there is only 1 item to be summed. It should only be summing the numbers until the blank space. I have looked at the code until I am blue in the face. Clearly I am missing something. If anyone can see the solution please let me know.

Thanks
Luke

 

[Scott T]

Try changing MY_START to

MY_START = Range("A" & r).End(xlUp).Row

Your original code was setting MY_START to the total row that was above if there was only one row to sum

 

[Kaper]

Or even better - store in additional variable a starting row instead of searching it.

Dim r As Long, oldr As Long
For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
  If Range("H" & r).Value <> Range("H" & r - 1) Then
    Rows(r).Resize(2).Insert
  End If
Next r
oldr = 2
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row + 1
    If IsEmpty(Range("a" & r).Value) Then
        Range("A" & r).Value = "Total"
        MY_END = r - 1
        MY_START = oldr
        Range("F" & r).Resize(1, 2).Formula = "=sum(F" & MY_START & ":F" & MY_END & ")"
        oldr = r + 2
        r = r + 1 'it's not the best practice to change for-next loop counter "manually", but of course it works
    End If
Next r
End Sub

But now, my_start and My_End are no longer needed, so:

Dim r As Long, oldr As Long
For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
  If Range("H" & r).Value <> Range("H" & r - 1) Then
    Rows(r).Resize(2).Insert
  End If
Next r
oldr = 2
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row + 1
    If IsEmpty(Range("a" & r).Value) Then
        Range("A" & r).Value = "Total"
        Range("F" & r).Resize(1, 2).Formula = "=sum(F" & oldr & ":F" &  r - 1 & ")"
        oldr = r + 2
        r = r + 1 'it's not the best practice to change for-next loop counter "manually", but of course it works
    End If
Next r
End Sub