• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 249
  • Last Modified:

Sum, Count and Copy

I have attached a sheet where i would like some VBA code to start at F2 and loop until it finds the first number and then select to the end, sum that and copy the sum to the tab "Corporate Actions" and paste it into the cell next to MI Ledger, so use offset, and then repeat the same but using count and offset (0,2)

I have manually done this to highlight what i need to achieve

Ideas, suggestions and code are welcome!

  • 2
1 Solution
You could do this using VBA, but why not just use the formula

Open in new window

in C16 and

Open in new window

in D16, if I understand your requirement correctly?
If you really do want code, as I'm guessing you may need to do similar with other accounts, this will do what you want I think.  I've tried to make it flexible so it looks up the MI LEDGER row, etc - you just have to specify where the column is you want to process.
Public Sub SumMILedger()

    Dim shtMI As Excel.Worksheet
    Dim shtCorpActions As Excel.Worksheet
    Dim dblSum As Double
    Dim dblCount As Double
    Dim lngFoundRow As Long
    Const cstrStartCell As String = "F2"
    Const clngAmountCol As Long = 2         ' column to place the results
    Const cstrAccountName As String = "MI LEDGER"  ' row marker to place the results
    Dim rngAmt As Excel.Range
    Dim rngLast As Excel.Range
    Dim rngOutput As Excel.Range
    ' reference the sheets needed
    Set shtMI = ActiveWorkbook.Worksheets("MI LEDGER")
    Set shtCorpActions = ActiveWorkbook.Worksheets("Corporate Actions")
    ' set te amount range starting in the cell requested, down to the last value in that col
    Set rngAmt = shtMI.Range(cstrStartCell)
    Set rngLast = shtMI.Cells(shtMI.Rows.Count, rngAmt.Column).End(xlUp)
    Set rngAmt = shtMI.Range(rngAmt.Cells(1), rngLast)

    ' get the values
    dblSum = Application.WorksheetFunction.Sum(rngAmt)
    dblCount = Application.WorksheetFunction.Count(rngAmt)
    ' find where to put them
    Set rngOutput = shtCorpActions.Columns(clngAmountCol)
    lngFoundRow = 0
    On Error Resume Next
    lngFoundRow = Application.WorksheetFunction.Match(cstrAccountName, rngOutput, 0)
    On Error GoTo 0
    ' if the output account description was matched then add the values
    If lngFoundRow > 0 Then
        shtCorpActions.Cells(lngFoundRow, clngAmountCol + 1).Value = dblSum
        shtCorpActions.Cells(lngFoundRow, clngAmountCol + 2).Value = dblCount
        MsgBox "Could not find output location"
    End If
End Sub

Open in new window

Seamus2626Author Commented:
Sometimes i get VBA stuck in my head and forget theres regular solutions!!


Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now