CODEWITHSUNDEEP
excelvba
FrenchConnections
FrenchConnections

Reputation: 391

Calculate running total while cells remain the same

I am working on creating a macro that creates a running total based on criteria in a neighboring column. I'm able to do it with a combination of formulas but I would like to be able to do it in VBA. The code I have thus far can handle it with a few rows, but not more than 4.

        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("O1") = ""

    If LastRow1 = 1 Then
        MsgBox "No Closed-Won for " & RepName
        ElseIf LastRow1 = 2 Then
            .Cells(2, LastColumn + 1).Formula = "=F2"
        ElseIf LastRow = 3 Then
            k = 0
            For k = 3 To LastRow1
            .Cells(k, LastColumn + 2).Value = Month(Worksheets(RepName.Text).Cells(k, 8))
            Next k
            .Cells(3, LastColumn + 1).Formula = "=F3+O2"
        ElseIf LastRow1 = 4 Then
            .Cells(2, LastColumn + 1).Value = .Cells(2, 6).Value
            .Cells(3, LastColumn + 1).Formula = "=F3+O2"
            .Cells(4, LastColumn + 1).Formula = "=F4+O3"
        ElseIf LastRow1 > 4 Then
            .Cells(2, LastColumn + 1).Value = .Cells(2, 6).Value
            .Cells(3, LastColumn + 1).Formula = "=F3+O2"
            Call Q1
        Else: 'do nothing
    End If

(This is the snippet of code that handles that particular action) I think there must be a better way to do this but I am not sure what it is. Any ideas would be appreciated.

Example of what the final product should look like

Upvotes: 1

Views: 102

Answers (1)

chris neilsen
chris neilsen

Reputation: 53126

The formula to use in cell C2 is

=IF(B2=B1,C1+A2,A2)

and copy down as far as required

The code to create that formula (if you must) is (Excel will take care of updating the cell references)

Sub Demo()

    Dim rng As Range
    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ws
        Set rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 2)
        rng.Formula = "=IF(B2=B1,C1+A2,A2)"
    End With
End Sub

Upvotes: 2

Related Questions