Statement reconciliation

P

PAOLO7673

New Member
Joined
Jul 4, 2024
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
Hi everyone.
I am kindly looking for a VBA instruction that compares 2 sheets with 2 columns each and highlights what found and leaves what is missing uncolored.
The date and amount must match each other or be the closest available date.
Then, all the mismatched row,
help.JPG
moved to a new third sheet for manual reconciliation.
Your help is greatly appreciated.
Thanks in advance.
Paul
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
What do you mean by "or be the closest available date"? Does not both the date and amount have to match exactly in order for it to count as a match?
 
Upvote 0
Engberg said:
What do you mean by "or be the closest available date"? Does not both the date and amount have to match exactly in order for it to count as a match?
Click to expand...
If date and amount are exacly the same, it maches. If the date isnt exactly the same( a few days+-) but the exact amount is found, it maches as well.
My target is to isolate the amounts that appear in one sheet only even though with a slightly diffence in the date.
Hope is more clear.
Thank you Engberg.
 
Upvote 0
Try running this. Format your A and B columns in all three sheets as Text first. A1 and B1 in all three sheets needs to be the title, just like in the image your image.

VBA Code: 
Public Function findMathingStatements()

    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Set s1 = Application.ActiveWorkbook.Sheets(1)
    Set s2 = Application.ActiveWorkbook.Sheets(2)
    Set s3 = Application.ActiveWorkbook.Sheets(3)
   
    highlightColour = RGB(150, 250, 150) ' <------------- You can adjust the highlight colour here
    daysInterval = 2 ' <--------- You can adjust the +- allowed days here
   
    lastRow1 = WorksheetFunction.Max(s1.Range("A" & Rows.Count).End(xlUp).Row, s1.Range("B" & Rows.Count).End(xlUp).Row)
    lastRow2 = WorksheetFunction.Max(s2.Range("A" & Rows.Count).End(xlUp).Row, s2.Range("B" & Rows.Count).End(xlUp).Row)
    lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
   
    s1.Range("A2:B" & lastRow1).Interior.ColorIndex = xlNone
    s2.Range("A2:B" & lastRow2).Interior.ColorIndex = xlNone
   
    s3.Range("A2:B" & lastRow3 + 1).ClearContents
   
    For i = 2 To lastRow1
        For j = 2 To lastRow2
            If s1.Range("B" & i).Value = s2.Range("B" & j).Value Then
                d1_text = Replace(s1.Range("A" & i).Value, "/", "")
                d2_text = Replace(s2.Range("A" & j).Value, "/", "")
               
                d1 = DateSerial(Right(d1_text, 2), Mid(d1_text, 3, 2), Left(d1_text, 2))
                d2 = DateSerial(Right(d2_text, 2), Mid(d2_text, 3, 2), Left(d2_text, 2))
   
                If Abs(DateDiff("d", d1, d2)) <= daysInterval Then
                    s1.Range("A" & i & ":B" & i).Interior.Color = highlightColour
                    s2.Range("A" & j & ":B" & j).Interior.Color = highlightColour
                End If
            End If
        Next
    Next
   
    For i = 2 To lastRow1
        If s1.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
            lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
            s3.Range("A" & lastRow3 + 1 & ":B" & lastRow3 + 1).Value = s1.Range("A" & i & ":B" & i).Value
        End If
    Next
   
    For i = 2 To lastRow2
        If s2.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
            lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
           s3.Range("A" & lastRow3 + 1 & ":B" & lastRow3 + 1).Value = s2.Range("A" & i & ":B" & i).Value
        End If
    Next
   
End Function
 
Upvote 0
Engberg said:
Try running this. Format your A and B columns in all three sheets as Text first. A1 and B1 in all three sheets needs to be the title, just like in the image your image.

VBA Code: 
Public Function findMathingStatements()

    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Set s1 = Application.ActiveWorkbook.Sheets(1)
    Set s2 = Application.ActiveWorkbook.Sheets(2)
    Set s3 = Application.ActiveWorkbook.Sheets(3)
  
    highlightColour = RGB(150, 250, 150) ' <------------- You can adjust the highlight colour here
    daysInterval = 2 ' <--------- You can adjust the +- allowed days here
  
    lastRow1 = WorksheetFunction.Max(s1.Range("A" & Rows.Count).End(xlUp).Row, s1.Range("B" & Rows.Count).End(xlUp).Row)
    lastRow2 = WorksheetFunction.Max(s2.Range("A" & Rows.Count).End(xlUp).Row, s2.Range("B" & Rows.Count).End(xlUp).Row)
    lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
  
    s1.Range("A2:B" & lastRow1).Interior.ColorIndex = xlNone
    s2.Range("A2:B" & lastRow2).Interior.ColorIndex = xlNone
  
    s3.Range("A2:B" & lastRow3 + 1).ClearContents
  
    For i = 2 To lastRow1
        For j = 2 To lastRow2
            If s1.Range("B" & i).Value = s2.Range("B" & j).Value Then
                d1_text = Replace(s1.Range("A" & i).Value, "/", "")
                d2_text = Replace(s2.Range("A" & j).Value, "/", "")
              
                d1 = DateSerial(Right(d1_text, 2), Mid(d1_text, 3, 2), Left(d1_text, 2))
                d2 = DateSerial(Right(d2_text, 2), Mid(d2_text, 3, 2), Left(d2_text, 2))
  
                If Abs(DateDiff("d", d1, d2)) <= daysInterval Then
                    s1.Range("A" & i & ":B" & i).Interior.Color = highlightColour
                    s2.Range("A" & j & ":B" & j).Interior.Color = highlightColour
                End If
            End If
        Next
    Next
  
    For i = 2 To lastRow1
        If s1.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
            lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
            s3.Range("A" & lastRow3 + 1 & ":B" & lastRow3 + 1).Value = s1.Range("A" & i & ":B" & i).Value
        End If
    Next
  
    For i = 2 To lastRow2
        If s2.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
            lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
           s3.Range("A" & lastRow3 + 1 & ":B" & lastRow3 + 1).Value = s2.Range("A" & i & ":B" & i).Value
        End If
    Next
  
End Function
Click to expand...
Hi Engberg
That works great for the matching.
Will you be so kind to apply a few changes on sheet 3 as per my screenshot? Just split the uncoloured from each sheet.
Will be super if sheet 3 starts from A6 & H6 instead of A1 & H1
Thanks a million.




HELP_2.JPG
 
Upvote 0
Here you go :)
Code: 
Public Function findMathingStatements()

Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set s1 = Application.ActiveWorkbook.Sheets(1)
Set s2 = Application.ActiveWorkbook.Sheets(2)
Set s3 = Application.ActiveWorkbook.Sheets(3)

highlightColour = RGB(150, 250, 150) ' <------------- You can adjust the highlight colour here
daysInterval = 2 ' <--------- You can adjust the +- allowed days here

lastRow1 = WorksheetFunction.Max(s1.Range("A" & Rows.Count).End(xlUp).Row, s1.Range("B" & Rows.Count).End(xlUp).Row)
lastRow2 = WorksheetFunction.Max(s2.Range("A" & Rows.Count).End(xlUp).Row, s2.Range("B" & Rows.Count).End(xlUp).Row)
lastRow3_1 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
lastRow3_2 = WorksheetFunction.Max(s3.Range("H" & Rows.Count).End(xlUp).Row, s3.Range("I" & Rows.Count).End(xlUp).Row)

s1.Range("A2:B" & lastRow1).Interior.ColorIndex = xlNone
s2.Range("A2:B" & lastRow2).Interior.ColorIndex = xlNone

s3.Range("A7:B" & lastRow3_1 + 1).ClearContents
s3.Range("H7:I" & lastRow3_2 + 1).ClearContents

For i = 2 To lastRow1
    For j = 2 To lastRow2
        If s1.Range("B" & i).Value = s2.Range("B" & j).Value Then
            d1_text = Replace(s1.Range("A" & i).Value, "/", "")
            d2_text = Replace(s2.Range("A" & j).Value, "/", "")
            
            d1 = DateSerial(Right(d1_text, 2), Mid(d1_text, 3, 2), Left(d1_text, 2))
            d2 = DateSerial(Right(d2_text, 2), Mid(d2_text, 3, 2), Left(d2_text, 2))

            If Abs(DateDiff("d", d1, d2)) <= daysInterval Then
                s1.Range("A" & i & ":B" & i).Interior.Color = highlightColour
                s2.Range("A" & j & ":B" & j).Interior.Color = highlightColour
            End If
        End If
    Next
Next

For i = 2 To lastRow1
    If s1.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
        lastRow3 = WorksheetFunction.Max(s3.Range("A" & Rows.Count).End(xlUp).Row, s3.Range("B" & Rows.Count).End(xlUp).Row)
        s3.Range("A" & lastRow3 + 1 & ":B" & lastRow3 + 1).Value = s1.Range("A" & i & ":B" & i).Value
    End If
Next

For i = 2 To lastRow2
    If s2.Range("A" & i & ":B" & i).Interior.Color <> highlightColour Then
        lastRow3 = WorksheetFunction.Max(s3.Range("H" & Rows.Count).End(xlUp).Row, s3.Range("I" & Rows.Count).End(xlUp).Row)
       s3.Range("H" & lastRow3 + 1 & ":I" & lastRow3 + 1).Value = s2.Range("A" & i & ":B" & i).Value
    End If
Next
    
End Function
 
Upvote 0
Morning Engberg....first of all thank your support!
I made the macro run with 500 row data and noticed that some amounts are taken twice.
The attached file shows the check of dates and amount I did and a recap on the right side of the sheet.
Basically what is already applyed cant be applyed a second time with the same date and amount and have to be left unapplyed.
Hope is all clear and wish that can be fixed!!
Thanks again.

Mismatched.xlsm
ABCDEFGHIJKL
1DATE AMOUNT DATE AMOUNT from clm A&B
231/12/20244,0031/12/20244,00VEROVERO matched twice 171,88
331/12/20244,0031/12/20244,00VEROVEROunmatched176,00347,88
424/01/20245,0024/01/20245,00VEROVERO
525/01/20245,0025/01/20245,00VEROVERO
626/01/20245,0026/01/20245,00VEROVEROTTL amount clm B2.978,86
727/01/20245,8027/01/20245,80VEROVEROmatched clm B2.630,98347,88
829/01/20247,2829/01/20247,28VEROVERO
930/01/202410,0030/01/202410,00VEROVEROTTL amount clm G2.630,98
1031/01/202411,0031/01/202411,00VEROVEROmatched clm G2.630,98-
1101/02/202412,0001/02/202412,00VEROVERO
1202/02/202412,0002/02/202412,00VEROVERO
1303/02/202412,0003/02/202412,00VEROVERO
1404/02/202413,0004/02/202413,00VEROVERO
1505/02/202413,0005/02/202413,00VEROVERO
1607/02/202415,0007/02/202415,00VEROVERO
1708/02/202416,0008/02/202416,00VEROVERO
1809/02/202417,5009/02/202417,50VEROVERO
1910/02/202418,8010/02/202418,80VEROVERO
2011/02/202419,0011/02/202419,00VEROVERO
2112/02/202419,5012/02/202419,50VEROVERO
2226/01/20245,00FALSOFALSO
2327/01/20245,80FALSOFALSO
2429/01/20247,28FALSOFALSO
2531/01/202411,00FALSOFALSO
2601/02/202412,00FALSOFALSO
2702/02/202412,00FALSOFALSO
2804/02/202413,00FALSOFALSO
2907/02/202415,00FALSOFALSO
3008/02/202416,00FALSOFALSO
3109/02/202417,50FALSOFALSO
3210/02/202418,80FALSOFALSO
3311/02/202419,00FALSOFALSO
3412/02/202419,50FALSOFALSO
3513/02/202421,0013/02/202421,00VEROVERO
3614/02/202422,0014/02/202422,00VEROVERO
3715/02/202422,0015/02/202422,00VEROVERO
3816/02/202422,0016/02/202422,00VEROVERO
3917/02/202424,5017/02/202424,50VEROVERO
4018/02/202424,5518/02/202424,55VEROVERO
4119/02/202425,0019/02/202425,00VEROVERO
4220/02/202425,8020/02/202425,80VEROVERO
4321/02/202428,5021/02/202428,50VEROVERO
4422/02/202430,0022/02/202430,00VEROVERO
4523/02/202431,0023/02/202431,00VEROVERO
4624/02/202431,0024/02/202431,00VEROVERO
4725/02/202431,0025/02/202431,00VEROVERO
4826/02/202432,0026/02/202432,00VEROVERO
4927/02/202432,0027/02/202432,00VEROVERO
5028/02/202432,5028/02/202432,50VEROVERO
5129/02/202433,0029/02/202433,00VEROVERO
5201/03/202433,0001/03/202433,00VEROVERO
5302/03/202434,0002/03/202434,00VEROVERO
5403/03/202434,0003/03/202434,00VEROVERO
5504/03/202434,0004/03/202434,00VEROVERO
5605/03/202434,0005/03/202434,00VEROVERO
5706/03/202434,4506/03/202434,45VEROVERO
5807/03/202435,5007/03/202435,50VEROVERO
5908/03/202436,0008/03/202436,00VEROVERO
6009/03/202436,0009/03/202436,00VEROVERO
6110/03/202436,0010/03/202436,00VEROVERO
6211/03/202436,0011/03/202436,00VEROVERO
6312/03/202437,0012/03/202437,00VEROVERO
6413/03/202437,0013/03/202437,00VEROVERO
6514/03/202437,5014/03/202437,50VEROVERO
6615/03/202438,0015/03/202438,00VEROVERO
6716/03/202438,0016/03/202438,00VEROVERO
6817/03/202438,0017/03/202438,00VEROVERO
6918/03/202439,0018/03/202439,00VEROVERO
7019/03/202439,0019/03/202439,00VEROVERO
7120/03/202440,0020/03/202440,00VEROVERO
7221/03/202440,0021/03/202440,00VEROVERO
7322/03/202440,0022/03/202440,00VEROVERO
7423/03/202440,0023/03/202440,00VEROVERO
7524/03/202440,0024/03/202440,00VEROVERO
7625/03/202441,0025/03/202441,00VEROVERO
7726/03/202441,00FALSOFALSO
7827/03/202441,00FALSOFALSO
7918/04/202447,00FALSOFALSO
8019/04/202447,00FALSOFALSO
8120/04/202447,0020/04/202447,00VEROVERO
8221/04/202448,0021/04/202448,00VEROVERO
8322/04/202448,0022/04/202448,00VEROVERO
8423/04/202448,0023/04/202448,00VEROVERO
8524/04/202448,0024/04/202448,00VEROVERO
8625/04/202449,0025/04/202449,00VEROVERO
8726/04/202449,0026/04/202449,00VEROVERO
8827/04/202449,0027/04/202449,00VEROVERO
8928/04/202449,0028/04/202449,00VEROVERO
9029/04/202450,0029/04/202450,00VEROVERO
9130/04/202450,0030/04/202450,00VEROVERO
9201/05/202450,0001/05/202450,00VEROVERO
9302/05/202451,8002/05/202451,80VEROVERO
9403/05/202452,0003/05/202452,00VEROVERO
9504/05/202452,0004/05/202452,00VEROVERO
9605/05/202452,0005/05/202452,00VEROVERO
9706/05/202454,0006/05/202454,00VEROVERO
9807/05/202454,0007/05/202454,00VEROVERO
9908/05/202455,0008/05/202455,00VEROVERO
10009/05/202455,0009/05/202455,00VEROVERO
Foglio1
Cell Formulas
RangeFormula
F2:G100F2=A2=D2
K2K2=SUM(B22:B34)
K3K3=+SUM(B77:B80)
L3L3=SUM(K2:K3)
K6K6=SUM(B:B)
L7,L10L7=+K6-K7
K9K9=SUM(E:E)
 
Upvote 0
Hi Engberg...wondering if you had the chance to check my last post and if a solution is possible. Many thanks.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA Find Cell from Date listed, in Columns, Return cell to highlight in color
Replies
7
Views
532
mumps
mumps
V
  • Solved
Compare data in three sets of columns, highlight non matches
Replies
9
Views
149
Eric W
Eric W
M
  • Solved
VBA to Insert Mismatched Row in separate worksheet
2 3
Replies
21
Views
806
Peter_SSs
Peter_SSs
J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
392
Jiraya_00
J
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
949
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,816
Messages
6,181,141
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top