Reconciliation / Matching Macro

R

richardallen

New Member
Joined
Feb 13, 2014
Messages
12
I am looking to write a macro to compare and 'match' 2 data sets.

They are currently in separate sheets and consist of:

Sheet 1: Sales Table with Sale Date & Sale Amount:

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]Sale Date[/TD]
[TD]Sale £[/TD]
[/TR]
[TR]
[TD]1/8[/TD]
[TD]£710[/TD]
[/TR]
[TR]
[TD]2/8[/TD]
[TD]£834[/TD]
[/TR]
[TR]
[TD]3/8[/TD]
[TD]£692[/TD]
[/TR]
[TR]
[TD]4/8[/TD]
[TD]£672[/TD]
[/TR]
[TR]
[TD]5/8[/TD]
[TD]£768[/TD]
[/TR]
[TR]
[TD]6/8[/TD]
[TD]£452[/TD]
[/TR]
[TR]
[TD]7/8[/TD]
[TD]£890[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2: Bank Table with Bank Date, Bank Amount and 2 spaces for the matched info

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Banked Date[/TD]
[TD]Bank £[/TD]
[TD]Sales Date[/TD]
[TD]Sales £[/TD]
[/TR]
[TR]
[TD]3/8[/TD]
[TD]£523[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3/8[/TD]
[TD]£830[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3/8[/TD]
[TD]£711[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9/8[/TD]
[TD]£420[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9/8[/TD]
[TD]£680[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9/8[/TD]
[TD]£767[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9/8[/TD]
[TD]£695[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I need to match similar amounts. Takings will be banked a few days after the sales day and are grouped. Bankings will differ (mostly a few pounds higher/lower).

I need to, using a macro, to find the likely sales and put them into the banking table.

Any ideas? Thanks.
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
Try this:-
NB:- See code notes !!
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Aug16
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn: [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    For n = -40 To 40 '[COLOR="Green"][B]Change the "- & +"figures to suit your allowable difference"[/B][/COLOR]
        [COLOR="Navy"]If[/COLOR] .exists(Dn.Value + n) [COLOR="Navy"]Then[/COLOR]
            .Item(Dn.Value + n).Offset(, 1) = CDate(Dn.Offset(, -1))
            .Item(Dn.Value + n).Offset(, 2) = Dn.Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
There's is a dot "." missing in the line below.
Code: 
[COLOR=#000080]With[/COLOR] Sheets("Sheet2")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("B2"),[B][COLOR=#FF0000][SIZE=5] .[/SIZE][/COLOR][/B]Range("B" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With

NB:- Although this code should give you an answer, unfortunately it will not always be the most suitable answer in terms of the closest.
 
Upvote 0
Mick, thanks. I simplified my example at the start as I was hoping to understand the code (which I just about do) and develop from there. But I am a bit stuck.

[this is going to be used in a scenario where there are cash sales and similar (but often not identical) cash bankings.

Current issues:
- This works ok for rounded numbers, but if I add 2 decimals (e.g. (£710.25) it doesn't work.
- there is no check that sheet 2 date [bankings] < sheet 1 date [sales]
- if number are similar it may use the same number twice. i.e. it finds the first match, not the best match.

Further developments
- It would be good to mark the sheet 1 sales when used so that (i) they are only used once, (ii) two remaining items can be used the following week (i.e. sales not banked this week)
- This works for store 1, my spreadsheet will have several stores (as defined by a code in column C). How is this best included so that (i) it only compares sales/bankings from the same store, and (ii) it then runs the same process for the next store. [the data is in a continuous, sorted, table].

[TABLE="width: 300"]
<tbody>[TR]
[TD]Sale Date[/TD]
[TD]Sale £[/TD]
[TD]Store[/TD]
[/TR]
[TR]
[TD]1/8[/TD]
[TD]£710[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]2/8[/TD]
[TD]£834[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]3/8[/TD]
[TD]£692[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]4/8[/TD]
[TD]£672[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]5/8[/TD]
[TD]£768[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]6/8[/TD]
[TD]£452[/TD]
[TD]LON[/TD]
[/TR]
[TR]
[TD]7/8[/TD]
[TD]£890[/TD]
[TD]LON[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
This code should deal with some of your queries.

The code:-
deletes the values once used
works with decimalised data.
marks column "D" of sheet (1) when value are once used.
at the moment accept value differences of +- 10

Try this on more complexed basic data, if the results are acceptable, please send an example showing data including related "Store" on both sheets.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG29Aug38
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dt [COLOR="Navy"]As[/COLOR] Date, K [COLOR="Navy"]As[/COLOR] Variant, temp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, 2).Value = "Used" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
      [COLOR="Navy"]If[/COLOR] Abs(Dn.Value - .Item(K).Value) < Abs(Dn.Offset(, 2) - Dn.Value) And _
        .Item(K).Offset(, -1).Value <= Dn.Offset(, -1).Value And _
        Not Abs(Abs(Dn.Value - .Item(K).Value)) > 10 [COLOR="Navy"]Then[/COLOR]
           
           Dn.Offset(, 1) = .Item(K).Offset(, -1).Value
           Dn.Offset(, 2) = .Item(K)
      temp = K
       [COLOR="Navy"]End[/COLOR] If
   
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]If[/COLOR] .Exists(temp) [COLOR="Navy"]Then[/COLOR]
 .Item(temp).Offset(, 2).Value = "Used"
 .Remove temp
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Many Thanks. I have tweaked a bit and seems to be working!

I have a few questions (largely to aid my understanding)...
- What does the code marked in red do?
- I am confused as to what sheet the code 'Dn' is looking at? Sheet K or Sheet A? Could this be changed to Aa on Sheet A and Kk on Sheet K?
- Does the code find the first match? Or the best match (lowest difference)?

Code:
Code: 
Sub MG02Sep17()
Dim Rng As Range, Dn As Range, n As Long, nn As Long, Dt As Date, K As Variant, temp As Variant
Dim ans As Long, Num As Long, Lp As Integer
Num = InputBox("Please Select Variable", "Variable", 10)
MsgBox "Number = " & Num


For Lp = 1 To 10
With Sheets("Sheet-A")
    Set Rng = .Range(.Range("G2"), .Range("G" & Rows.Count).End(xlUp))
End With
With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
For Each Dn In Rng
    If Not Dn.Offset(, 3).Value = "Used" Then
        Set .Item(Dn.Value) = Dn
    End If
Next
With Sheets("Sheet-K")
    Set Rng = .Range(.Range("G2"), .Range("G" & Rows.Count).End(xlUp))
End With
Dim R As Range


For Each Dn In Rng
    For Each K In .keys
[COLOR=#ff0000]      If Abs((Abs(Dn.Value) - Abs(.Item(K).Value))) < Abs((Abs(Dn.Offset(, 7)) - Abs(Dn.Value))) And _
        .Item(K).Offset(, -2).Value <= Dn.Offset(, -3).Value And _
[/COLOR]           Dn.Offset(, 1).Value = .Item(K).Offset(, 1) And _
           Not Abs(Abs(Dn.Value) - Abs(.Item(K).Value)) > Num Then
           Dn.Offset(, 5) = .Item(K).Offset(, -2).Value
           Dn.Offset(, 6) = .Item(K).Offset(, -1).Value
           Dn.Offset(, 7) = .Item(K)
           n = n + 1
           
           temp = K
       End If
   
    Next K
If .Exists(temp) Then
 .Item(temp).Offset(, 3).Value = "Used"
 .Remove temp
End If
Next Dn
[COLOR=#ff0000]Set temp = Range("L1").Resize(Rng.Count).SpecialCells(xlCellTypeConstants)
[/COLOR]End With
Next Lp
MsgBox "Macro Complete"
End Sub
 
Upvote 0
Try the modified code below, it should be a bit better.
The first of the first two lines in red finds two values (A) the difference between columns "G & N" (Sheet_K) at the first loop of "Dn" and " K" and (B) the value as the loops proceed, if the value becomes less then that value is input to column "N", until the value is the least it can be from the available amounts (sheet_A. column "G") with the other criteria being met.

The next line compares the dates to ensure the criteria is met.

The "Set Temp" line was left over from me checking the number of values in "N", and is not now required.
I've also adjusted the position of "Used" column, it was incorrect,which accounted for the loop at the beginning (now removed) because duplicate amounts where being entered. !!!!

The use of 2 lots of Rng and Dn is not the most understandable thing to do , but once the first range has been through the dictionary, its not needed again, hence using the variables twice!!
Hope this is a bit better !!


Code: 
[COLOR=navy]Sub[/COLOR] MG03Sep56
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nn [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Dt [COLOR=navy]As[/COLOR] Date, K [COLOR=navy]As[/COLOR] Variant, temp [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] ans [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Lp [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
ans = MsgBox("Please [COLOR=navy]Select[/COLOR] " & vbLf & """Yes"" = 5" & vbLf & """No"" = 10", vbYesNo + vbInformation)
[COLOR=navy]If[/COLOR] ans = vbYes [COLOR=navy]Then[/COLOR] Num = 5 Else Num = 10
[COLOR=navy]With[/COLOR] Sheets("Sheet-A")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("G2"), .Range("G" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not Dn.Offset(, 3).Value = "Used" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]Set[/COLOR] .Item(Dn.Value) = Dn
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]With[/COLOR] Sheets("Sheet-K")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("G2"), .Range("G" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
      [COLOR=navy]If[/COLOR] Abs((Abs(Dn.Value) - Abs(.Item(K).Value))) < Abs((Abs(Dn.Offset(, 7)) - Abs(Dn.Value))) And _
        .Item(K).Offset(, -2).Value <= Dn.Offset(, -3).Value And _
           Not Abs(Abs(Dn.Value) - Abs(.Item(K).Value)) > Num [COLOR=navy]Then[/COLOR]
           Dn.Offset(, 5) = .Item(K).Offset(, -2).Value
           Dn.Offset(, 6) = .Item(K).Offset(, -1).Value
           Dn.Offset(, 7) = .Item(K)
           n = n + 1
           temp = K
       [COLOR=navy]End[/COLOR] If
   [COLOR=navy]Next[/COLOR] K
    [COLOR=navy]If[/COLOR] .Exists(temp) [COLOR=navy]Then[/COLOR]
        .Item(temp).Offset(, 3).Value = "Used"
        c = c + 1
        Cells(c, "K") = temp
        .Remove temp
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
Merge data in listbox based on another listbox after search for name and dates
Replies
6
Views
169
Omran Y
O
A
  • Solved
Filter data in listbox on form based on matching part of item in two comboboxes
Replies
9
Views
116
Ali M
A
O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
194
Omran Y
O
A
  • Solved
Lookup PAAF ID based on Worker ID and date range
Replies
3
Views
123
Fluff
Fluff
O
  • Question Question
sum or subtract for the same cell based on match DATE
Replies
0
Views
322
Omran Y
O

Forum statistics

Threads
1,223,992
Messages
6,175,831
Members
452,673
Latest member
LaMiaAvy

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