I want to check within an Excel VBA macro the cells in a standardized table (meaning fix column headers, but no fix placement so that the table can start anywhere in a fix named sheet).
Here is an example of the table:
Explanation of example table:
The data is for invoicing. In colum S named “invoice ID” there is the ID for the invoice, meaning that row 72 (ID=1) is one invoice with one invoice position, therefore only one amount in total (here 5 EUR). The second invoice (ID=2) contains two invoice positions with one total amount of 10 HKD (including 8 + 2 HKD positions).
With the VBA macro I want to check each cell in the table for the correct entry and format. In addition, for the case of multi-position invoice, I want to check the total amount whether it is the correct sum of the individual positions (in the example for invoice 2: I want to check if the total amount 10 is the correct sum of 8 and 2).
The total amount is always placed in the first row of the invoice group.
I already created following code but it doesn’t work.
Does anybody have an idea what the problem is or how the code would work?
Many thanks in advance for your help!!!
Stefi
Option Explicit
Private WB As Workbook, ws As Worksheet
Private i As Long, lEnde As Long, strHeader As String
Private rngFind As Range, booCheck As Boolean, rngHeader As Range, rngFormula As Range, rngKey As Range, rngUsed As Range
Private idCol As Range
Private headerRow As Range
Private dataRange As Range
Private currentID As Variant
Private previousID As Variant
Private groupStartRow As Long
Private groupEndRow As Long
Private lastRow As Long
Private lastCol As Long
Private numRows As Long
Private isMultiLine As Boolean
Private cell As Range
Private col As Range
Private groupRange As Range
Private groupRow As Range
Private rowIndex As Long
Private cellRef As Range
Private cellValue As Variant
Private cellFormula As String
Private cellFormat As String
Private containsLineBreak As Boolean
Function Main_Check(ByVal strFilePath As String) As String
On Error GoTo ErrorHandler
If strFilePath = "" Then GoTo ErrorHandler
Set WB = Workbooks.Open(strFilePath)
Set ws = WB.Worksheets("SpecificSheet")
With ws
'//Define last row and column which must be processed
lEnde = .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2, 2).End(xlUp).Row
lColEnde = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
'//Find beginning of table
Set rngFind = .Cells.Find(what:=Settings.Cells(Settings.Range("Header_Start").Row + 1, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
If rngFind Is Nothing Then
booCheck = False
End
End If
lEnde = .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2, 2).End(xlUp).Row
Set rngUsed = .Range(rngFind.Address, .Cells(lEnde, lColEnde))
booCheck = IsErrorAll(rngUsed)
'//Define header row und ID-column
Set headerRow = rngUsed.EntireRow
lastRow = .Cells(.Rows.Count, rngUsed.Column).End(xlUp).Row
lastCol = .Cells(headerRow.Row, .Columns.Count).End(xlToLeft).Column
Set idCol = .Range(.Cells(headerRow.Row + 1, rngUsed.Column), .Cells(lastRow, lastCol))
'//Group for ID
currentID = idCol.Cells(1, 1).Value
'Check if first group has ID = 1
If currentID <> 1 Then
currentID.Interior.Color = vbRed
booCheck = False
End If
If booCheck = False Then GoTo Ende
groupStartRow = idCol.Cells(1, 1).Row
previousID = currentID 'Initialize first group
For i = 2 To idCol.Rows.Count + 1 'Loop via IDs
If i > idCol.Rows.Count Or idCol.Cells(i, 1).Value <> currentID Then
'Group end reached
groupEndRow = idCol.Cells(i - 1, 1).Row
'Process group
Call ProcessGroup(.Rows(groupStartRow & ":" & groupEndRow), .Rows(headerRow))
'Check ongoing IDs
If i <= idCol.Rows.Count Then
Dim nextID As Variant
nextID = idCol.Cells(i, 1).Value
If nextID <> previousID + 1 Then
idCol.Cells(i, 1).Interior.Color = vbRed
booCheck = False
End If
If booCheck = False Then GoTo Ende
previousID = nextID 'Set the new last ID
End If
'Start new group
If i <= idCol.Rows.Count Then
currentID = idCol.Cells(i, 1).Value
groupStartRow = idCol.Cells(i, 1).Row
End If
End If
Next i
End Function
Sub ProcessGroup(groupRange As Range, headerRow As Range)
'Check if group is multi-line
isMultiLine = (groupRange.Rows.Count > 1)
'Check all columns and all rows of group
rowIndex = 1 'Initialize row index within group
If groupRange.Rows.Count = 1 And groupRange.Columns.Count = 1 Then
Set cellRef = groupRange
Else
Set cellRef = groupRange.Cells(1, 1)
End If
For Each groupRow In groupRange.Rows
Call Processing1(groupRow)
rowIndex = rowIndex + 1 'Increase row index
Next groupRow
End Sub
Sub Processing1(groupRow As Range)
'//Invoice-ID (only formal check, content already checked)
strKey = "ID"
Set rngKey = Settings.Cells(1, 1).EntireColumn.Find(what:=strKey, LookIn:=xlValues, lookat:=xlWhole)
strHeader = Settings.Cells(rngKey.Row, 2).Value
Set rngHeader = ws.Range(rngFind, ws.Cells(rngFind.Row, lColEnde)).Find(what:=strHeader, LookIn:=xlValues, lookat:=xlWhole)
cellRef = ws.Cells(groupRow.Row, rngHeader.Column)
containsLineBreak = (InStr(1, cellRef.Value, vbLf) > 0)
If (cellRef.Value Like "#" Or cellRef.Value Like "##" Or cellRef.Value Like "###")
And cellRef.NumberFormat = "General" And Not containsLineBreak And Not Left(cellRef.Formula, 2) = "=+" Then
cellRef.Interior.Pattern = xlNone
Else
cellRef.Interior.Color = vbRed
booCheck = False
End If
'//.... (further checks for further columns)
End Sub
2
I did a code for you that go through S column and find the ID and verify the total. Positions with only one ID will be considered as “OK”.
Please change the relevant names and columns ex (Sheet Name is Invoice) and Description will be on column AA (i,29).
I hope it helps ^^
Sub CheckInvoices()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("YourSheetName") ' Change to your actual sheet name
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "S").End(xlUp).Row ' Find the last row with data in column S
Dim i As Long
Dim currentInvoiceID As Long
Dim sumPositions As Double
Dim totalAmount As Double
Dim isTotalAmountRow As Boolean
Dim invoiceStartRow As Long
Dim positionCount As Long
On Error GoTo ErrorHandler
For i = 2 To lastRow ' Assuming row 1 is headers
If IsNumeric(ws.Cells(i, 19).Value) Then ' Check if cell in column S contains a numeric value (Invoice ID)
If currentInvoiceID <> ws.Cells(i, 19).Value Then ' New invoice found
If currentInvoiceID <> 0 Then ' Skip the first iteration
' Check previous invoice's total amount and write validation message
If positionCount = 1 Then
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " are OK"
ElseIf sumPositions = totalAmount Then
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " are OK"
Else
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " is not correct"
End If
End If
' Reset for the new invoice
currentInvoiceID = ws.Cells(i, 19).Value
sumPositions = 0
isTotalAmountRow = True
invoiceStartRow = i ' Track the starting row of the invoice
positionCount = 0 ' Reset position count for new invoice
End If
' Check if it's the total amount row
If isTotalAmountRow Then
totalAmount = ws.Cells(i, 24).Value ' Assuming total amount is in column X
isTotalAmountRow = False
Else
' Sum the positions
sumPositions = sumPositions + ws.Cells(i, 24).Value ' Assuming position amounts are in column X
End If
positionCount = positionCount + 1 ' Increase position count
End If
Next i
' Check last invoice's total amount and write validation message
If currentInvoiceID <> 0 Then ' Ensure it's not the first iteration
If positionCount = 1 Then
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " are OK"
ElseIf sumPositions = totalAmount Then
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " are OK"
Else
ws.Cells(invoiceStartRow, 27).Value = "Sum of Positions " & currentInvoiceID & " is not correct"
End If
End If
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " at row " & i & " column " & invoiceStartRow
End Sub
New contributor
user28820944 is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
1
I would use an Excel table. Using these it doesn’t matter where the table is on the sheet – you can reference it by name.
To create your table select cells S71:Y75 and press Ctrl+T (remember to click Table Has Headers). The table will be called Table1, Table2, etc – you can rename these in the Tables tab that appears when you select a cell within the table.
The code below assumes the data table is in the same workbook as the code (ThisWorkbook). If it’s in a different workbook change ThisWorkbook to ws after opening the other workbook and referencing the sheet as you have in your original code.
Option Explicit
Public Sub Main_Check()
On Error GoTo ErrorHandler
Dim DataTable As ListObject
Set DataTable = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
Dim Cell As Range
Dim Total As Double
Dim Running As Double
Dim RowNum As Long
Dim IDCount As Long
Dim CurID As Long
Dim MsgText As String
With DataTable
'Look at each invoice ID in the table.
For Each Cell In .ListColumns("invoice ID").DataBodyRange
'Count how many occurrences of invoice ID appear.
IDCount = Application.WorksheetFunction.CountIf(.ListColumns("invoice ID").DataBodyRange, Cell)
'Which row of the table is the code looking at?
RowNum = Cell.Row - .HeaderRowRange.Row
'Is the current ID different from the previous one?
If Cell <> Cell.Offset(-1) Then
'Code is on the first row of the ID, so that's the total.
Total = .ListColumns("amount").DataBodyRange.Cells(RowNum)
'Reset the running total.
Running = 0
'If there's only one invoice ID then Running total will equal the total.
If IDCount = 1 Then Running = Total
CurID = 1
Else
'If the current ID is the same as the previous then the code will start use a running total.
Running = Running + .ListColumns("amount").DataBodyRange.Cells(RowNum)
CurID = CurID + 1
End If
'If the code has reached the end of that invoice ID then add the results to a text string.
If CurID = IDCount Then
MsgText = MsgText & Cell & IIf(Running = Total, " Correct", " Error") & vbCr
End If
Next Cell
End With
'Display the text string.
MsgBox MsgText, vbInformation + vbOKOnly, "Results"
ende:
'Any tidy up code before exiting the procedure.
Exit Sub 'This is the end of the main body of the procedure. Error handling goes after this.
ErrorHandler:
Select Case Err.Number
Case 123 'If error number 123 occurs deal with using this code.
'Deal with error
Resume ende 'Resume on the "ende" label
'Or Resume Next - resumes execution on the line following the error.
'Or Resume - resumes execution on the line causing the error.
Case Else
MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number & " in Main_Check()"
Resume ende
End Select
End Sub
1