Quote Originally Posted by jindon View Post
Blanks are no good, but the "API1000023456" should not affect the result.

Need to see the actual data type anyway if possible.

P.S.
Past midnight, so I will see you tomorrow if any problem left.



Thanks jindon! There was some special character on the end of some of my Col-A values.. I took those out and it works Great. I also added a timer, With a list sheet containing about 1600 values, being matched to Data Sheet with about 6,000 values, it pulls almost 170,000 rows to results sheet, in 6.58 minutes. This is the code that did it courtesy of jindon:

Option Explicit

Sub test()
    Dim a, b, i As Long, ii As Long, iii As Long, iv, x
    Dim w, ub As Long, n As Long, t As Long, e
    Const myLimit As Long = 4000
    Application.ScreenUpdating = False
    Sheets("sample results").Cells.ClearContents
    a = Sheets("sample data").Cells(1).CurrentRegion.Value
    ub = UBound(a, 2): x = 1
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1: ReDim w(1 To UBound(a, 2))
        For i = UBound(a, 1) To 1 Step -1
            If Not .Exists(a(i, 1)) Then
                ReDim w(1 To UBound(a, 2), 1 To 1)
            Else
                w = .Item(a(i, 1))
                ReDim Preserve w(1 To UBound(a, 2), 1 To UBound(w, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                w(ii, UBound(w, 2)) = a(i, ii)
            Next
            .Item(a(i, 1)) = w
            t = Application.Max(t, UBound(w, 2) + 1)
        Next
        a = Sheets("sample list").Cells(1).CurrentRegion.Value
        For i = UBound(a, 1) To 1 Step -myLimit
            ReDim b(1 To myLimit * t, 1 To UBound(a, 2) + ub + 1)
            For ii = i To Application.Max(i - myLimit - 1, 1) Step -1
                If .Exists(a(ii, 1)) Then
                    For iii = 1 To UBound(.Item(a(ii, 1)), 2)
                        n = n + 1
                        For iv = 1 To UBound(a, 2)
                            b(n, iv) = a(ii, iv)
                        Next
                        For iv = 1 To UBound(.Item(a(ii, 1)), 1)
                            b(n, ub + iv + 1) = .Item(a(ii, 1))(iv, iii)
                        Next
                    Next
                End If
                n = n + 1
            Next
            Sheets("sample results").Cells(x, 1).Resize(n, UBound(b, 2)).Value = b
            x = x + n + 1: n = 0
        Next
    End With
    Application.ScreenUpdating = True
    Sheets("sample results").Select
End Sub