Copy the values of a collection to a 2D array in VBA

Question

I seem to be banging my ahead against the proverbial brick wall. I have a loop which runs and populates a collection. There are approximately 20000 rows and 11 columns. I ne

Answer 1

Sub Tester()

Dim k As String
Dim i As Long, j As Long, r As Long, x As Long
Dim arr() As Variant
Dim dict

    ReDim arr(1 To UBound(ArrayOrg1_cMat, 1) + 1, 1 To 11)
    r = 0
    Set dict = CreateObject("scripting.dictionary")

    For i = 0 To UBound(ArrayOrg1_cMat())
        For j = 0 To UBound(ArrayOrg2_cMat())

            If ArrayOrg2_cMat(j, 0) = ArrayOrg1_cMat(i, 0) Then
            If ArrayOrg2_cMat(j, 1) = ArrayOrg1_cMat(i, 1) Then
            If ArrayOrg2_cMat(j, 2) = ArrayOrg1_cMat(i, 2) Then
            If ArrayOrg2_cMat(j, 3) = ArrayOrg1_cMat(i, 3) Then

                ' I'm skipping the constant values in your original key...
                k = Join(Array(ArrayOrg1_cMat(i, 0), _
                               ArrayOrg1_cMat(i, 6), _
                               ArrayOrg1_cMat(i, 2), _
                               ArrayOrg1_cMat(i, 3)), "~")

                If Not dict.exists(k) Then
                    r = r + 1
                    dict.Add k, True
                    arr(r, 1) = ""                   'Name
                    arr(r, 2) = ArrayOrg1_cMat(i, 0) 'AD ID
                    arr(r, 3) = ""                   'Email
                    arr(r, 4) = ""                   'Requester
                    arr(r, 5) = ArrayOrg1_cMat(i, 6) 'Webapp
                    arr(r, 6) = ArrayOrg1_cMat(i, 2) 'Scenario
                    arr(r, 7) = ArrayOrg1_cMat(i, 3) 'Role
                    arr(r, 8) = "PL"                 'Business Unit
                    arr(r, 9) = "NONE"
                    arr(r, 10) = "NONE"
                    arr(r, 11) = "NONE"
                End If


            End If
            End If
            End If
            End If

        Next j
    Next i

    ActiveSheet.Range("a2").Resize(r, 11).Value = arr

End Sub