I have a data set as shown below
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