Home > Back-end >  Macros > Column totals
Macros > Column totals

Time:03-04

I have a data set as shown below

enter image description here

The goal is to take the column totals manually (below the row "Total") and take the variance with the system extracted values to validate the accurcy.

I have used the below code to choose the column dynamically and take the totals to automate the process.

Sub ColTotals()

'1. Identifying the relevant column, in this case Beg bal
    ThisWorkbook.Worksheets("Output").Cells.Find(What:="Beg bal", After:=Range("A1"), LookIn:=xlValues _
    , LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False).Activate

'2.Assignment of column values
        C_OI = ActiveCell.Column

'Find the last non-blank cell in column B
    lRow = ThisWorkbook.Worksheets("Output").Cells(Rows.Count, 2).End(xlUp).Row
    Debug.Print (lRow) '

'3. loop to calculate sum from the last row until first row excluding header
            
    Sum_OI = 0

    For i = lRow To C_OI
    Sum_OI = Sum_OI   Worksheets("Output").Cells(i, C_OI).Value

    Next
    Worksheets("Output").Cells(lRow   2, C_OI).Value = Sum_OI.Value 'At the end of loop, assigns the column total to the required field,
    
    'Take variance to identify for any difference
    Worksheets("Output").Cells(lRow   2, C_OI).Value = Cells(lRow   1, C_OI).Value - Cells(lRow, C_OI).Value 'Calculating the difference between Report sum and calculated sum

End Sub

However, I'm unable to achieve with the above code, as no output is thrown and also no error message to debug or identify the issue.

Alternative way/correction to the above code would be much appreciated.

CodePudding user response:

Checking Totals

Option Explicit

Sub ColTotals()
    
    Const wsName As String = "OutPut"
    Const hTitle As String = "Beg bal"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim hCell As Range
    Set hCell = ws.Cells.Find(hTitle, , xlFormulas, xlWhole, xlByRows)
    If hCell Is Nothing Then Exit Sub ' header not found
    
    Dim Col As Long: Col = hCell.Column
    Dim fRow As Long: fRow = hCell.Row   1
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
    
    Dim Total As Double
    Dim r As Long
    
    For r = fRow To lRow - 1
        Total = Total   ws.Cells(r, Col).Value
    Next
    
    ws.Cells(lRow   1, Col).Value = Total
    ws.Cells(lRow   2, Col).Value = Total - ws.Cells(lRow, Col).Value

End Sub
  • Related