VBA Create a macro to match items in a bank reconciliation - payment booking/ Bank debit

Question

I have an excel based bank reconciliation that I'm doing a manual matching like the example below using ABS or conditional format, but I need to do a faster matching with a macro.

This is the format of the bank reconciliation

                          HSBC BANK RECONCILIATION      
Date   Ref  Type         Doc#       Description                Amount           

03/31   1   Payment      991893     FUNDING GFR 2423           3.000.000,00

03/22   2   Bank Debit   991893     International Payment      (3.000.000,00)

This is a Payment Booked in the Accounting Books with a Reference number/Description and amount, and also added the type of adjustment or action required in the last column.

I need to highlight both lines when both doc# are the same and the sum of the amounts net to zero, just then move to a sheet called "Compensated Items",

Some details

• I've hide some columns not needed, as month/abs/comments/adjusmtents.

• the headers columns are:

• Date: A

• Type: D

• Doc#: E

• Description: F

• Amount: G

• Adjustment: J

  • Also I can have a Bank Credit that should match to a Receivable.

  • I could match also if only the amounts are netting to zero as some banks don't put good references or doc# to match.

---

Below the Code I made so far to compensate items by ABS:

Sub CompensationMacro2()

'Automated Bank Reconciliation Process'
'**********************************'
'****Made by Juan Martin Castro****'
'**********************************'
'-------------------------------------------------------------'
'VBA Code to compensate Items 80% Functional
'VBA Code to Move items to Compensation tab 100% functional
'Improvements to add later:
'Accruals
'Bank Charges
'Fundings
'Reclass
'JE's that shouldn't be in the rec
'Add First Macro of Compensation code
'InputBox Bank Rec period linked to the "Summary" sheet
'-------------------------------------------------------------'

Dim positive As Currency
Dim negative As Currency
Dim positive As Long
Dim negative As Long
Dim i As Integer
Dim m As Integer
Dim o As Integer


i = 1
LastRow = Cells(20000, 6).End(xlUp).Row
m = 1
o = 2

Range("G2").Select

Do

Application.DisplayAlerts = False

positive = Cells(2, 7).Offset(m, 0).Value
negative = Cells(2, 7).Offset(o, 0).Value
positiveRow = Cells(2, 7).Offset(m, 0).Row
negativeRow = Cells(2, 7).Offset(o, 0).Row

If positive + negative = 0 Then

'Highlight compensated items

Cells(positiveRow, 7).Interior.Color = rgbLightBlue
Cells(negativeRow, 7).Interior.Color = rgbLightBlue
Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"

'Filter by Color
ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
    216, 230), Operator:=xlFilterCellColor

'Select Range

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

'Copy to the "Compensated" sheet

Selection.Copy
Sheets("Compensated").Select
Cells(20000, 1).End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Sheets("Pending Items").Select

'Delete Lines from "Pending Items" sheet

Range("A2").Offset(1, 0).Delete
Range("A2").Offset(1, 0).Delete

ActiveSheet.ShowAllData

'm = m + 1

Else

' Call Next loop

Call SecondItinerationSearchForCompensation

End If

'o = o + 1

    Loop Until negativeRow >= LastRow

    Application.DisplayAlerts = False

'Compensated Items Counting - add ID VBA code to make it work

        CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value

        MsgBox CompensatedItems & " Transactions Compensated", Title:="Bank Reconciliation Process (JMC)"


End Sub

This is the Second Macro that will be doing practically the same just move one variable O= O + 1 that will impact in "negative" variable.

Sub SecondItinerationSearchForCompensation()

Dim CompensatedItems As Currency
m = 1
o = 2
LastRow = Cells(20000, 6).End(xlUp).Row

        Do
        LastRow = Cells(20000, 6).End(xlUp).Row
        Application.DisplayAlerts = False

        positive = Cells(2, 7).Offset(m, 0).Value
        negative = Cells(2, 7).Offset(o, 0).Value
        positiveRow = Cells(2, 7).Offset(m, 0).Row
        negativeRow = Cells(2, 7).Offset(o, 0).Row

        If positive + negative = 0 Then

'Highlight Compensated Items

        Cells(positiveRow, 7).Interior.Color = rgbLightBlue
        Cells(negativeRow, 7).Interior.Color = rgbLightBlue
        Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
        Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"

'Filter by Color

        ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
            216, 230), Operator:=xlFilterCellColor

'Select Range

        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select

'Copy to the "Compensated" Sheet

        Selection.Copy
        Sheets("Compensated").Select
        Cells(20000, 1).End(xlUp).Offset(2, 0).Select
        ActiveSheet.Paste
        Sheets("Pending Items").Select

'Delete Lines from "Pending Items" sheet

        Range("A" & positiveRow).Delete
        Range("A" & (negativeRow) - 1).Delete

        ActiveSheet.ShowAllData

        o = 1

        Else

'Last Loop should be add to move from m position

         'm = m + 1 check where I should add this 

        End If

        o = o + 1

'It's where the macro will compensate - should be "positive" variable as it it the first amount checked from the top

        Loop Until negativeRow >= LastRow

    Application.DisplayAlerts = False

    'Compensated Items Counting - add Counter Items "ID" code to make it work


    CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value

    MsgBox CompensatedItems & " Transactions Compensated - Please Check Compensated Sheet", Title:="Bank Reconciliation Process (JMC)"

    End Sub

1.The macro is highlighting the first two items if they sum is zero, (that works very well when "positive" and "negative" variables net zero), then the macro move the items to the "Compensated" sheet succesfully and delete them from the "Pending Items" sheet (no longer need them).

2.The second macro works when the "positive" and "negative" variables is not summing zero and then the macro will look for the next variable for "negative" variable to net to zero the "positive" variable.

What I need is the code to move the variable "positive" when the variable "negative" reaches the last row (as it has no matching it's ok if the variable goes to the second row to re do the proces) In other case I'll need Do Loops as many rows as I have.. and is not the intention.

If you can help me to reduce the code and fix the macro would be great... I'm just 3 months wisdom on VBA.

Answer 1

I'd split the algorithm down like this.

1. User highlights the column used to group data; in your case, doc#
2. VBA sorts the data by this column, which results in like-data appearing in adjacent rows
3. VBA steps through the rows, looking at the group column for changes. When it finds a change it starts a new group. If it finds no-change, it expands the existing group to include the current row.
4. VBA applies 'conditions' to each group. A condition might be "Do all contents of column(5) (for a particular group) net/add to zero?". Conditional results are stored in a new column as Yes, or No. Any number of conditions can be defined as will fit into new columns.
5. Once conditional data is calculated and applied, you can do all the cosmetic stuff as a separate pass - it might be better to keep the original data in one place, and copy 'extracts' out to different spreadsheets, in case you want to rerun the reconciliation later.

The advantage of writing it like this is that steps 1, 2 and 3 can be reused for almost any reconciliation you have to do in the future. Writing some code for parts 4 and 5 might be specific to your rec, but if you wrote it just so, you should be able to use as a template for future recs.