VBA - Using scripting.dictionary with multiple instances of same key

[Manawydan]

I'm trying to use scripting.dictionary to combine multiple sheets. One of the sheets has multiple instances of a primary key as this relates to candidates taking exams and they can take multiple attempts. I've tried to amend previous brilliant advice from Fluff on how to use scripting.dictionary ( VBA - Merging two or more arrays using a unique ID ) to combine sheets but I'm not getting the outcomes I expected. I thought the way I'd written the script it would combine all attempts based on the ID - so all AA1 and CC3 would be collected as I'm searching for the ID and the attempt number, however running with Debug.Print shows that it's not finding AA1 and CC3 twice but finds the last instance of both.

The data is below, my current VBA is below that, Debug.Print output after that, current outcome following and expected outcome at the end :

Main Sheet

ID​	First Name​	Surname​	Attempt 1 Date​	Attempt 1 Outcome​	Attempt 2 Date​	Attempt 2 Outcome​
AA1	Jean Luc	Picard
AA2	Tony	Stark
AA3	Luke	Skywalker
BB1	Frodo	Baggins
BB2	Bilbo	Baggins
BB3	Rasitlin	Majere
CC1	Optimus	Prime
CC2	Ellen	Ripley
CC3	Frasier	Crane

Form Sheet

ID​	Attempt Date​	Attempt Number​	Attempt Outcome​
AA1	01/10/2020​	1​	Fail
AA2	02/10/2020​	1​	Pass
BB1	02/10/2020​	1​	Pass
CC3	03/10/2020​	1​	Fail
AA1	04/10/2020​	2​	Pass
CC3	05/10/2020​	2​	Fail

VBA

Sub ExamCopyRange()

    Dim vMain As Variant
    Dim vStage As Variant
    Dim vi1 As Long
    Dim vi2 As Long
    Dim vLastRow As Long
   
    vLastRow = ActiveWorkbook.Sheets("Candidates_new").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    vMain = Sheets("Candidates_new").Range("A2:A" & vLastRow).Value
       
    ReDim Preserve vMain(LBound(vMain) To UBound(vMain), LBound(vMain, 2) To UBound(vMain, 2) + 4)
       
    vLastRow = ActiveWorkbook.Sheets("Form1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    vStage = Sheets("Form1").Range("A2:C" & vLastRow).Value
    
    With CreateObject("scripting.dictionary")
        For vi2 = 1 To UBound(vStage)
            .Item(vStage(vi2, 1)) = vi2
        Next vi2
        For vi1 = 1 To UBound(vMain)
            If .Exists(vMain(vi1, 1)) Then
                If vStage(.Item(vMain(vi1, 1)), 3) = 1 Then
                    vMain(vi1, 2) = vStage(.Item(vMain(vi1, 1)), 2)
                    vMain(vi1, 3) = vStage(.Item(vMain(vi1, 1)), 4)
                    Debug.Print "ID: " & vMain(vi1, 1) & " | Attempt 1 Date: " & vMain(vi1, 2) & " | Attempt 1 Outcome: " & vMain(vi1, 3)
                End If
                If vStage(.Item(vMain(vi1, 1)), 3) = 2 Then
                    vMain(vi1, 4) = vStage(.Item(vMain(vi1, 1)), 2)
                    vMain(vi1, 5) = vStage(.Item(vMain(vi1, 1)), 4)
                    Debug.Print "ID: " & vMain(vi1, 1) & " | Attempt 2 Date: " & vMain(vi1, 4) & " | Attempt 2 Outcome: " & vMain(vi1, 5)
                End If
            End If
        Next vi1

    End With
    
    For vi1 = 1 To UBound(vMain)
        vMain(vi1, 1) = vMain(vi1, 2)
        vMain(vi1, 2) = vMain(vi1, 3)
        vMain(vi1, 3) = vMain(vi1, 4)
        vMain(vi1, 4) = vMain(vi1, 5)
    Next vi1
    
    Sheets("Candidates_new").Select
    
    Sheets("Candidates_new").Range("D2:G" & UBound(vMain) + 1).Value = vMain

End Sub

Debug.Print Output

ID: AA1 | Attempt 2 Date: 04/10/2020 | Attempt 2 Outcome: Pass
ID: AA2 | Attempt 1 Date: 02/10/2020 | Attempt 1 Outcome: Pass

Current Outcome

ID​	First Name​	Surname​	Attempt 1 Date​	Attempt 1 Outcome​	Attempt 2 Date​	Attempt 2 Outcome​
AA1	Jean Luc	Picard			04/10/2020​	Pass
AA2	Tony	Stark	02/10/2020​	Pass
AA3	Luke	Skywalker
BB1	Frodo	Baggins	02/10/2020​	Pass
BB2	Bilbo	Baggins
BB3	Raistlin	Majere
CC1	Optimus	Prime
CC2	Ellen	Ripley
CC3	Frasier	Crane			05/10/2020​	Fail

Expected Outcome

ID​	First Name​	Surname​	Attempt 1 Date​	Attempt 1 Outcome​	Attempt 2 Date​	Attempt 2 Outcome ​
AA1	Jean Luc	Picard	01/10/2020​	Fail	04/10/2020​	Pass
AA2	Tony	Stark	02/10/2020​	Pass
AA3	Luke	Skywalker
BB1	Frodo	Baggins	02/10/2020​	Pass
BB2	Bilbo	Baggins
BB3	Raistlin	Majere
CC1	Optimus	Prime
CC2	Ellen	Ripley
CC3	Frasier	Crane	03/10/2020​	Fail	05/10/2020​	Fail

Has anyone got any advice how I can resolve this please?

Thank you.

 

[Fluff]

You need to loop through vmain 1st & then vstage like

Sub Manawydan()

    Dim vMain As Variant
    Dim vStage As Variant
    Dim vi1 As Long
    Dim vi2 As Long
    Dim vLastRow As Long
   
    vLastRow = ActiveWorkbook.Sheets("Sheet1").Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    vMain = Sheets("Sheet1").Range("A2:A" & vLastRow).Value
       
    ReDim Preserve vMain(LBound(vMain) To UBound(vMain), LBound(vMain, 2) To UBound(vMain, 2) + 4)
       
    vLastRow = ActiveWorkbook.Sheets("sheet2").Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    vStage = Sheets("sheet2").Range("A2:D" & vLastRow).Value
    
    With CreateObject("scripting.dictionary")
        For vi2 = 1 To UBound(vMain)
            .Item(vMain(vi2, 1)) = vi2
        Next vi2
        For vi1 = 1 To UBound(vStage)
            If .Exists(vStage(vi1, 1)) Then
                If vStage(vi1, 3) = 1 Then
                    vMain(.Item(vStage(vi1, 1)), 2) = vStage(vi1, 2)
                    vMain(.Item(vStage(vi1, 1)), 3) = vStage(vi1, 4)
                    Debug.Print "ID: " & vMain(vi1, 1) & " | Attempt 1 Date: " & vMain(vi1, 2) & " | Attempt 1 Outcome: " & vMain(vi1, 3)
                End If
                If vStage(vi1, 3) = 2 Then
                    vMain(.Item(vStage(vi1, 1)), 4) = vStage(vi1, 2)
                    vMain(.Item(vStage(vi1, 1)), 5) = vStage(vi1, 4)
                    Debug.Print "ID: " & vMain(vi1, 1) & " | Attempt 2 Date: " & vMain(vi1, 4) & " | Attempt 2 Outcome: " & vMain(vi1, 5)
                End If
            End If
        Next vi1

    End With
    
    For vi1 = 1 To UBound(vMain)
        vMain(vi1, 1) = vMain(vi1, 2)
        vMain(vi1, 2) = vMain(vi1, 3)
        vMain(vi1, 3) = vMain(vi1, 4)
        vMain(vi1, 4) = vMain(vi1, 5)
    Next vi1
    
'    Sheets("Candidates_new").Select
    
    Sheets("sheet1").Range("D2:G" & UBound(vMain) + 1).Value = vMain

End Sub

 

[Manawydan]

Thank you Fluff, that works exactly as I need, it makes sense. Thank you again for your time and solution.

 

[Fluff]

You're welcome & thanks for the feedback.