Reconciliation / Matching Macro

[richardallen]

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:

Sale Date	Sale £
1/8	£710
2/8	£834
3/8	£692
4/8	£672
5/8	£768
6/8	£452
7/8	£890

<tbody>
</tbody>

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

Banked Date	Bank £	Sales Date	Sales £
3/8	£523
3/8	£830
3/8	£711
9/8	£420
9/8	£680
9/8	£767
9/8	£695

<tbody>
</tbody>

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.

 

[MickG]

Try this:-
NB:- See code notes !!

[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

 

[richardallen]

Where do I access the code notes? It is debugging on the 4th line.

Thanks.

 

[MickG]

There's is a dot "." missing in the line below.

[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.

 

[richardallen]

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].

Sale Date	Sale £	Store
1/8	£710	LON
2/8	£834	LON
3/8	£692	LON
4/8	£672	LON
5/8	£768	LON
6/8	£452	LON
7/8	£890	LON

<tbody>
</tbody>

 

[MickG]

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.

[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

 

[richardallen]

Thanks. That works great. I will upload a file with the additional data.

 

[richardallen]

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:

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

 

[MickG]

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 !!

[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