Scripting Dictionary and matching values in offset cell

Elliottj2121

Board Regular
Joined
Apr 15, 2021
Messages
56
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello

I am looking for some help with a scripting dictionary issue. What is going on is in Column F are posted check amounts to a database and Column H are the actual check values. I am trying to automate finding errors in posting and/or errors in the check writing. The image is how I would like the end result to look. For example, the posted amount in cell(5, 6) is three dollars short to its corresponding check in cell(11, 8) the column offset value is "No Match". The same goes for the posted amount in cell(12, 6), this check was posted to the database but no check was collected. Column H are values that are manually entered, Column F is the last column in a data set copied over from another spreadsheet. Any help is greatly appreciated! Thank you!!!
1627613228404.png


VBA Code:
Sub VerifyChecks(wkb As Workbook)
    Dim Ws As Worksheet
    Dim CkValues As Scripting.Dictionary
    Dim R As Long, i As Long
    Dim vlr As Variant
    vlr = LastRow(Ws)
    Set Ws = wkb.Worksheets(1)
    If vlr > 0 Then
        Set CkValues = New Dictionary
            For R = 2 To vlr
        If Not CkValues.Exists(Ws.Cells(R, 8).Value) Then
        CkValues.Add CStr(Ws.Cells(R, 8).Value), R
        End If
       Next R
      End If
    If vlr > 0 Then
        For R = 2 To vlr
            If CkValues.Exists(CStr(Ws.Cells(R, 6).Value)) Then
            i = CkValues(CStr(Ws.Cells(R, 6).Value))
            Ws.Range("H" & R).Copy Ws.Cells(i, 7)
        Else
        Ws.Cells(i, 7).Offset(0, 1).Value = ""
        End If
    Next R
    End If
End Sub

Function LastRow(sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = sh.Cells.Find(What:="*", _
                          After:=sh.Range("A1"), _
                          lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
For example, the posted amount in cell(5, 6) is three dollars short to its corresponding check in cell(11, 8) the column offset value is "No Match".
1627615042073.png

I see that the values are the same.

And if you just use the Vlookup formula:

Dante Amor
FGH
1PostedVerificationEnter
226,614.5926,614.5922,640.82
325,276.1925,276.1918,405.55
423,909.0123,909.0117,953.68
523,806.3623,806.3615,756.63
622,640.8222,640.8211,057.86
718,405.5518,405.5515,756.63
817,953.6817,953.6826,614.59
915,756.6315,756.6325,276.19
1015,756.6315,756.6323,909.01
1111,057.8611,057.8623,806.36
1210,696.72No Match
Hoja6
Cell Formulas
RangeFormula
G2:G12G2=IFERROR(VLOOKUP(F2,$H$2:$H$11,1,0),"No Match")
 
Upvote 0
1627616574833.png


I can observe that you have duplicate values, so vlookup would not work.
I show you how it would be with Dictionary, to even search for duplicates, if you have 2 equal values in column F, it means that you should have 2 equal values in column H. If you have 2 in F and only 1 in H. Then one of the F values must be "No Match".
Try this:

VBA Code:
Sub check_values()
  Dim a As Variant
  Dim i As Long, lr As Long
  Dim dic As Object
  
  Set dic = CreateObject("Scripting.Dictionary")
  lr = Sheets(1).Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
  a = Range("F2:H" & lr).Value
  
  For i = 1 To UBound(a)
    If a(i, 3) <> "" Then dic(a(i, 3)) = dic(a(i, 3)) + 1
  Next
  
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) And dic(a(i, 1)) > 0 Then
      a(i, 2) = a(i, 1)
      dic(a(i, 1)) = dic(a(i, 1)) - 1
    Else
      a(i, 2) = "No Match"
    End If
  Next
  Range("G2").Resize(UBound(a, 1)).Value = Application.Index(a, , 2)
End Sub
 
Upvote 0
Solution
The following formula works.
I put some duplicates.

Dante Amor
FGH
1PostedVerificationEnter
226,614.5926614.5922,640.82
325,276.1925276.1918,405.55
423,909.0123909.0117,953.68
523,806.36No Match15,756.63
622,640.8222640.8211,057.86
718,405.5518405.5515,756.63
817,953.6817953.6826,614.59
915,756.6315756.6325,276.19
1015,756.6315756.6323,909.01
1115,756.63No Match23,803.36
1210,696.72No Match
Hoja6
Cell Formulas
RangeFormula
G2:G12G2=IF(COUNTIFS($F$2:F2,F2)<=COUNTIF($H$2:$H$11,F2),F2,"No Match")
 
Upvote 0
View attachment 43822

I can observe that you have duplicate values, so vlookup would not work.
I show you how it would be with Dictionary, to even search for duplicates, if you have 2 equal values in column F, it means that you should have 2 equal values in column H. If you have 2 in F and only 1 in H. Then one of the F values must be "No Match".
Try this:

VBA Code:
Sub check_values()
  Dim a As Variant
  Dim i As Long, lr As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
  lr = Sheets(1).Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
  a = Range("F2:H" & lr).Value
 
  For i = 1 To UBound(a)
    If a(i, 3) <> "" Then dic(a(i, 3)) = dic(a(i, 3)) + 1
  Next
 
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) And dic(a(i, 1)) > 0 Then
      a(i, 2) = a(i, 1)
      dic(a(i, 1)) = dic(a(i, 1)) - 1
    Else
      a(i, 2) = "No Match"
    End If
  Next
  Range("G2").Resize(UBound(a, 1)).Value = Application.Index(a, , 2)
End Sub
Thank you so much! this worked perfectly!!!!!
 
Upvote 0
Perhaps you have a particular reason for using the dictionary object for this task but you could avoid any of that looping by utilising Dante's formula concept, just applying it via vba.

VBA Code:
Sub CkeckValues()
  With Sheets(1)
    With .Range("G2:G" & .Range("F" & Rows.Count).End(xlUp).Row)
      .Formula = "=IF(COUNTIFS($F$2:F2,F2)<=COUNTIF($H$2:$H$" & .Parent.Range("H" & Rows.Count).End(xlUp).Row & ",F2),F2,""No Match"")"
      .Value = .Value
    End With
  End With
End Sub

BTW, I suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

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