Multiple Dictionaries???

[reberryjr]

When this code was originally established, the requirements provided to me were to identify instances where the data in columns A, B, C, D & G matched; and place a Y in a particular column. If the data across the same columns did not match, create a new record. Now, the requirements have changed. I now need to code for some instances using columns A, B, C, D & G; some instances using only column A, and some instances using only column B; based on the Queue.

I'm not even entirely certain where to start. Should I look at creating multiple dictionaries based on the Queue? I'm thinking that there has to be a simpler way.

Here is the code that I'm using now:

Private Sub MD1_TP_Bump()
Application.ScreenUpdating = False
Dim m As Workbook
Dim mTP, mMD1 As Worksheet
Dim mMDLR, mTPLR As Long
Dim Rng As Range
Dim RngList As Object
Set m = ThisWorkbook
Set mTP = ThisWorkbook.Sheets("Total_Population")
Set mMD1 = ThisWorkbook.Sheets("MD1")
Set RngList = CreateObject("Scripting.Dictionary")
mMDLR = mMD1.Range("A" & Rows.Count).End(xlUp).Row
mTPLR = mTP.Range("A" & Rows.Count).End(xlUp).Row
'Adds data from columns A, B, C, D & G; from the Total Population tab; to the dictionary.
For Each Rng In mTP.Range("A2", mTP.Range("A" & mTP.Rows.Count).End(xlUp))
    If Not RngList.Exists(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)) Then
        RngList.Add Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6), Rng
    Else
        Set RngList(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)) = _
            Union(RngList(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)), Rng)
    End If
Next
'If the data in columns A, B, C, D & G on the MD1 tab have a match on the Total Population tab, insert Y in the MD1 column.  If there isn't a match _
the entire record is copied from MD1 and pasted to TP.
For Each Rng In mMD1.Range("A2", mMD1.Range("A" & mMD1.Rows.Count).End(xlUp))
    If RngList.Exists(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)) Then
        RngList(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)).Offset(, 12).Value = "Y"
    ElseIf Not RngList.Exists(Rng.Value & "|" & Rng.Offset(0, 1) & "|" & Rng.Offset(0, 2) & "|" & Rng.Offset(0, 3) & "|" & Rng.Offset(0, 6)) Then
        mMD1.Range("A" & Rng.Row & ":P" & Rng.Row).Copy mTP.Cells(mTP.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next
RngList.RemoveAll
Call Formatting
Application.ScreenUpdating = True
End Sub

 

[reberryjr]

So, I've been playing with the code, and I can't get either of these attempts to work:

Sub MD1_Bump()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim m As Workbook
Dim mMD1, mTP As Worksheet
Dim mMDLR, mTPLR As Long
Dim Rng As Range
Dim RngList As Object
Set m = ThisWorkbook
Set mMD1 = m.Worksheets("MD1")
Set mTP = m.Worksheets("Total_Population")
Set RngList = CreateObject("Scripting.Dictionary")
mMDLR = mMD1.Range("A" & Rows.Count).End(xlUp).Row
mTPLR = mTP.Range("A" & Rows.Count).End(xlUp).Row
With mTP
    On Error Resume Next
    .UsedRange.AutoFilter Field:=9, Operator:=xlFilterValues, Criteria1:=Array("HLMS", "Workbaskets")
For Each Rng In mTP.Range("B2", mTP.Range("B" & mTP.Rows.Count).End(xlUp).SpecialCells(xlCellTypeVisible))
    If Not RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
        RngList.Add Rng.Value & "|" & Rng.Offset(0, 7), Rng
    Else
        Set RngList(Rng.Value & "|" & Rng.Offset(0, 7)) = Union(RngList(Rng.Value & "|" & Rng.Offset(0, 7)), Rng)
    End If
Next
With mMD1
    On Error Resume Next
    .UsedRange.AutoFilter Field:=9, Operator:=xlFilterValues, Criteria1:=Array("HLMS", "Workbaskets")
For Each Rng In mMD1.Range("B2", mMD1.Range("B" & mMD1.Rows.Count).End(xlUp).SpecialCells(xlCellTypeVisible))
    If RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
        RngList(Rng.Value & "|" & Rng.Offset(0, 7)).Offset(0, 11).Value = "Y"
    ElseIf Not RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
        mMD1.Range("A" & Rng.Row & ":P" & Rng.Row).Copy mTP.Cells(mTP.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next
RngList.RemoveAll
End With
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub MD1_Bump2()
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Dim m As Workbook
 Dim mMD1, mTP As Worksheet
 Dim mMDLR, mTPLR As Long
 Dim Rng As Range
 Dim RngList As Object
 Set m = ThisWorkbook
Set mMD1 = m.Worksheets("MD1")
 Set mTP = m.Worksheets("Total_Population")
 Set RngList = CreateObject("Scripting.Dictionary")
 mMDLR = mMD1.Range("A" & Rows.Count).End(xlUp).Row
 mTPLR = mTP.Range("A" & Rows.Count).End(xlUp).Row
 With mMD1
     On Error Resume Next
     .UsedRange.AutoFilter Field:=9, Operator:=xlFilterValues, Criteria1:=Array("HLMS", "Workbaskets")
         For Each Rng In mMD1.Range("B2", mMD1.Range("B" & mMD1.Rows.Count).End(xlUp).SpecialCells(xlCellTypeVisible))
             If Not RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
                 RngList.Add Rng.Value & "|" & Rng.Offset(0, 7), Rng
             Else
                 Set RngList(Rng.Value & "|" & Rng.Offset(0, 7)) = Union(RngList(Rng.Value & "|" & Rng.Offset(0, 7)), Rng)
             End If
         Next
             With mTP
             On Error Resume Next
             .UsedRange.AutoFilter Field:=9, Operator:=xlFilterValues, Criteria1:=Array("HLMS", "Workbaskets")
                 For Each Rng In mTP.Range("B2", mTP.Range("B" & mTP.Rows.Count).End(xlUp).SpecialCells(xlCellTypeVisible))
                 If RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
                     RngList(Rng.Value & "|" & Rng.Offset(0, 7)).Offset(0.11).Value = "Y"
                 ElseIf Not RngList.exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
                     mMD1.Range("A" & Rng.Row & ":P" & Rng.Row).Copy mTP.Cells(mTP.Rows.Count, "A").End(xlUp).Offset(1, 0)
                 End If
             Next
             End With
End With
                 
 RngList.RemoveAll
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 End Sub

 

[reberryjr]

I'm trying this code, but it seems to be registering the value of cell A1 as the Rng. I need it to look at the filtered values of column I. I can't use the contents of column A, as they can change over the course of the Associates' work performed.

Sub MD1_Pop()
Application.ScreenUpdating = False
Dim m As Workbook
Dim mTP, mMD1 As Worksheet
Dim mMDLR, mTPLR As Long
Dim Rng, Rng1 As Range
Dim RngList As Object
Set m = ThisWorkbook
Set mTP = ThisWorkbook.Sheets("Total_Population")
Set mMD1 = ThisWorkbook.Sheets("MD1")
Set RngList = CreateObject("Scripting.Dictionary")
mMDLR = mMD1.Range("A" & Rows.Count).End(xlUp).Row
mTPLR = mTP.Range("A" & Rows.Count).End(xlUp).Row
'Filters the MD1 tab to only HLMS and LRM accounts, then adds the Queue and Primary Key to the dictionary. _
Then the code enters a Y in the MD1 column of the Total Population tab, where the same combination of Queue and Primary key exists. _
If the same combination of Queue and Primary Key doesn't exist, that row is copied from the MD1 tab, and pasted onto the next available row _
on the Total Population tab.
With mMD1
    On Error Resume Next
    .UsedRange.AutoFilter Field:=9, Operator:=xlFilterValues, Criteria1:=Array("HLMS", "Workbaskets")
End With
    For Each Rng In mMD1.Range("I2", mMD1.Range("I" & mMD1.Rows.Count).End(xlUp).SpecialCells(xlCellTypeVisible))
        If Not RngList.Exists(Rng.Value & "|" & Rng.Offset(0, -7)) Then
            RngList.Add Rng.Value & "|" & Rng.Offset(0, -7), Rng
        Else
            Set RngList(Rng.Value & "|" & Rng.Offset(0, -7)) = Union(RngList(Rng.Value & "|" & Rng.Offset(0, -7)), Rng)
        End If
    Next
        For Each Rng In mTP.Range("I2", mTP.Range("I" & mTP.Rows.Count).End(xlUp).Row)
            If RngList.Exists(Rng.Value & "|" & Rng.Offset(0, -7)) Then
                RngList(Rng.Value & "|" & Rng.Offset(0, -7)).Offset(0, 4).Value = "Y"
            ElseIf Not RngList.Exists(Rng.Value & "|" & Rng.Offset(0, -7)) Then
                mMD1.Range("A" & Rng.Row & ":P" & Rng.Row).Copy mTP.Cells(mTP.rowscount, "A").End(xlUp).Offset(1, 0)
            End If
        Next
RngList.RemoveAll
Application.ScreenUpdating = True
End Sub