Automation required for bank reconciliation

Please attach your workbook, easier to work that way.

Since this is my first post it is not allowing me to attach any file or link or images!
Is there any other way I can send you the workbook?

The paperclip Icon is broken. you are allowed to upload excel workbooks

1. Click Go advanced right bottom under the replybox.
2. Scroll down to the "Manage Attachments" under the advanced text editor
3. pick the file to upload and choose upload.
4. close the window
5. complete your message text and post your message with the attachement

(attachement does not always show under attachement link. try to p"review post" to see if the attachment was added. )

Could you give a clear example of the workbook that you provided?

As I said I have 2 sheets in my workbook - Bank Statement and Bank Book.
So Basically I have to reconcile entries in Bank Statement sheet with entries in Bank Book sheet.

For reconciling I have to use various combinations for matching.

Here is the procedure:

If the "Date & Description & Amount" of a row in the first sheet matches with "Date & Description & Amount" of any other row in second sheet then I should get a unique code/number in the "Matching Reference" cells of the both the rows

If it does not match,
then match the "Description & Amount" in both the sheets as earlier and bring the unique code.

If this also does not match then show "unmatched" in "Matching Reference" cell.

I have attached a fresh sheet!
Hope this is understandable!

Seems like a very interesting task.

Allright. Sorry for taking so long, I was away for a week and this took some time to figure out.

Option Explicit 'Always start your code with this. You have to declare your variables wirh DIM and REDIM statements, this makes the code more robust.

Sub CompareBanks()
    Application.ScreenUpdating = False 'Disable screenupdates for faster code execution
    
    Dim wb         As Workbook         'Workbook variable (we will store this workbook in it)
    Dim StatWs     As Worksheet        'The Statement worksheet
    Dim BankWs     As Worksheet        'The bank worksheet
    Dim lastRSt    As Long             'Helper to know lastrow on statement
    Dim lastRBnk   As Long             'Helper to know lastrow on bankws
    Dim c          As Range            'Helper range
    Dim c2         As Range            'Helper range
    Dim FirstFoundAddress As String    'Helper string to store a cell adress
    Dim ID         As Long             'Unique ID
    Dim FullMatch  As Long             'Counter for fullmatch
    Dim PartialMatch As Long           'Counter for partial match
    Dim Nomatch    As Long             'Counter for no match

    'First we set our workbook and worksheet variables
    Set wb = ThisWorkbook
    Set StatWs = wb.Worksheets("Bank Statement") 'Please note that using Index is a better solution, so if you change your worksheet name it will still work as long as worksheet index don't change!
    Set BankWs = wb.Worksheets("Bank Book")

    lastRSt = StatWs.Cells(Rows.Count, "B").End(xlUp).Row 'Find lastRow on statement sheet
    lastRBnk = BankWs.Cells(Rows.Count, "B").End(xlUp).Row 'Find lastRow on bank sheet

    For Each c In StatWs.Range("B2:B" & lastRSt) 'We must start with converting the date data to a actual date on the Statement worksheet
        c.Value = DateValue(c.Text)    'Loop all cells. Run cell value to a date with DateValue command
    Next c
       
    ID = 1000                          'We will start our unique ID's with 1000. You can change this number to anything.

    'Now comes the meat of the code. Here is how it works:
    'Loop all cells from Statement worksheet that are found in Column B.
    'Try to find a match of the cell's offset (description) from BankWS range. If a match is found, then store the match adress to FirsFoundAdress
    'Then check if the match is a full, partial or a no match. Use given rules to assign ID's To values. Loop this until you are back to the firstFound adress, and then move to next
    'Cell on Statment WS.
    
    For Each c In StatWs.Range("B2:B" & lastRSt) 'Loop all cells in Column B in statment WS
        With BankWs.Range("C2:C" & lastRBnk) 'This is the range where we try to find a match
            Set c2 = .Find(What:=c.Offset(0, 1), LookAt:=xlPart, after:=.Item(.Cells.Count)) 'If a match of C.offset(0,1) is found (description) then set that cell to C2
            If Not c2 Is Nothing Then  'If a match is found
                FirstFoundAddress = c2.Address 'Store the found first address
                Do                     'Iniatate the loop
                
                    If c2.Offset(0, -1) = c And c2 = c.Offset(0, 1) And c2.Offset(0, 1) = c.Offset(0, 2) Then 'Check if all 3 given criteria are a match
                        c.Offset(0, 3) = ID 'Add unique ID to statement WS
                        c2.Offset(0, 2) = ID 'Add unique ID to bank WS
                        ID = ID + 1    'Increase ID number
                        'Optinal, color ID green for full match
                        c.Offset(0, 3).Interior.Color = vbGreen
                        c2.Offset(0, 2).Interior.Color = vbGreen
                        FullMatch = FullMatch + 1
                    End If
                
                    If c2.Offset(0, 1) = c.Offset(0, 2) And c.Offset(0, 3) = vbNullString Then 'If desc and amount matches, and a ID has not been assigned
                        c.Offset(0, 3) = ID 'Add unique ID to statement WS
                        c2.Offset(0, 2) = ID 'Add unique ID to bank WS
                        ID = ID + 1    'Increase ID
                        'Optinal, color ID yellow for partial match
                        c.Offset(0, 3).Interior.Color = vbYellow
                        c2.Offset(0, 2).Interior.Color = vbYellow
                        PartialMatch = PartialMatch + 1
                    End If
                    Set c2 = .FindNext(after:=c2) 'Find next match
                Loop Until c2.Address = FirstFoundAddress 'Do this untill we are back on the firstFound adress
            End If
        End With
        FirstFoundAddress = vbNullString 'Reset FirstFound adress
    Next c                             'Move to next cell on Statement WS

    Set c = Nothing                    'Clear variables
    Set c2 = Nothing


    'Now loop both "MATCH" ranges, and if no matches has been found then add the information to the cell
    For Each c In StatWs.Range("E2:E" & lastRSt)
        If c = vbNullString Then
            With c
                .Value = "No Match!"
                .Interior.Color = vbRed
            End With
            Nomatch = Nomatch + 1
        End If
    Next c

    For Each c In BankWs.Range("E2:E" & lastRBnk)
        If c = vbNullString Then
            With c
                .Value = "No Match!"
                .Interior.Color = vbRed
            End With
        End If
    Next c

    Application.ScreenUpdating = True  'Enable screenupdates back
    
    MsgBox "Fullmatch: " & FullMatch & vbNewLine & "PartialMatch: " & PartialMatch & vbNewLine & "No match: " & Nomatch
    
    'Clear match variables
    FullMatch = 0
    PartialMatch = 0
    Nomatch = 0
End Sub

Works flawlessly! Thanks a lot!

Hi Mate...does your excel work okay.
could you upload the excel here please.

Can you share how you did this? I have the same situation. Thanks

As all the necessary is yet in this thread !

Ok I see it now - too complicated for my excel knowledge. Thanks anyway

Would this be able to give exact info like full match =which row, partial match which rows in a separate worksheet.
I am really keen to know if a modification can be done on your macro to obtain that, especially the partial matches.
I have the same challenge now.

Hello, I have a similar issue reconciling bank stmt activity to GL activity, with one added wrinkle. There maybe multiple transactions on the GL side that make up one transaction on the bank statement activity. I am fairly new to VBA, but this sure seems to be the closes thing i have found to solve my problem. Please help!

Hi I also required this VBA but when i try i am getting

"Subscript out of range error" on the below line

Set StatWs = wb.Worksheets("Bank Statement")