Scripting Dictionary Kicking my Behind

[reberryjr]

If the underlying scenario is true, then I want the value in column I to map over to column Q. I've been looking online, and at past dictionaries I've received help on, but I can't seem to figure out where I'm going wrong.

Sub IQR_Calcs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim m As Workbook
Dim mI As Worksheet, mM As Worksheet, mD As Worksheet, mO As Worksheet, mP As Worksheet, mV As Worksheet
Dim mILR As Long, mMLR As Long, mDLR As Long, mOLR As Long, mPLR As Long, mVLR As Long, i As Long
Dim Rng As Range
Dim Dic As Object
Set m = ThisWorkbook
Set mI = m.Sheets("CC_IQR")
Set mM = m.Sheets("CC_MC")
Set mD = m.Sheets("CC_MD")
Set mO = m.Sheets("ORC_PAR")
Set mP = m.Sheets("PRF")
Set mV = m.Sheets("Variables")
mILR = mI.Range("A" & Rows.Count).End(xlUp).Row
mMLR = mM.Range("A" & Rows.Count).End(xlUp).Row
mDLR = mD.Range("A" & Rows.Count).End(xlUp).Row
mOLR = mO.Range("A" & Rows.Count).End(xlUp).Row
mPLR = mP.Range("A" & Rows.Count).End(xlUp).Row
mVLR = mV.Range("A" & Rows.Count).End(xlUp).Row
'Identify the VTC start date.
Set Dic = CreateObject("Scripting.Dictionary")
For Each Rng In mI.Range("A2", mI.Range("A" & mI.Rows.Count).End(xlUp))
If Not Dic.exists(Rng.Value & Rng.Offset(0, 11)) Then
Dic.Add Rng.Value & Rng.Offset(0, 11), Nothing
End If
Next
For Each Rng In mD.Range("A2", mD.Range("A" & mD.Rows.Count).End(xlUp))
If Dic.exists(Rng.Value & Rng.Offset(0, 7)) Then
mD.Range("I" & Rng.Row).Copy
mI.Range("Q" & Rng.Row).PasteSpecial xlPasteValues
Else
If Not Dic.exists(Rng.Value & Rng.Offset(0, 11)) Then
mI.Range("Q" & Rng.Row) = "Review"
End If
End If
Next
Dic.RemoveAll
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[Legacy 143009]

I hope this helps:

Sub test()
  Dim mDdict As Object, mIRange As Variant, mDRange As Variant
  Set mDdict = CreateObject("Scripting.Dictionary")
 
  With Worksheets("mD")
  mDRange = .Range("A1:I" & .Cells(Rows.Count, 1).End(xlUp).Row)
  End With
  With Worksheets("mI")
  mIRange = .Range("A1:Q" & .Cells(Rows.Count, 1).End(xlUp).Row)
  For i = 1 To UBound(mDRange, 1)
    If Not mDdict.exists(mDRange(i, 1) & mDRange(i, 8)) Then
      mDdict.Add mDRange(i, 1) & mDRange(i, 8), mDRange(i, 9)
    End If
  Next
  For i = 1 To UBound(mIRange, 1)
    If mDdict.exists(mIRange(i, 1) & mIRange(i, 12)) Then
      mIRange(i, 17) = mDdict(mIRange(i, 1) & mIRange(i, 12))
    End If
  Next
  .Range("Q1").Resize(UBound(mIRange)) = WorksheetFunction.Index(mIRange, 0, 17)
  End With
End Sub