Performing MATCH/INDEX on large dataset - excel

Question

I have a dataset of 55.000 rows with 35.000 email-addresses of which 31.000 are unique, so a couple of users occupy multiple rows. I need to find the rows of these users and add them to a class object.
Loading the email column into an array and performing a MATCH/INDEX lookup took 200 seconds. It's acceptable for now, but definitely not fast enough for it's intended use of 200-500K datasets.
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim dict As Dictionary
Set dict = CreateObject("scripting.dictionary")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set UserRange = Range(Cells(2, 11), Cells(LastRow, 11))
For Each cell In UserRange
dict(cell.value) = dict(cell.value) + 1
Next
Debug.Print "Number of users: " & dict.Count
UserArray = Range(Cells(2, 11), Cells(LastRow, 11))
UserArray = WorksheetFunction.Transpose(WorksheetFunction.Transpose(WorksheetFunction.Transpose(UserArray)))
For Each User In dict
Dim UserIndex() As Variant
ReDim UserIndex(1 To dict(User))
For i = 1 To dict(User)
Row = WorksheetFunction.Match(User, UserArray, 0)
UserIndex(i) = Row
UserArray(Row) = Empty
Next
For i = LBound(UserIndex) To UBound(UserIndex)
Debug.Print User, UserIndex(i)
Next
Next
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds"
I could probably build a block-based index based on source (every imported file +-10.000 entries has a start- and endrow) and speed it up by looking only in the appropriate block. But maybe there is another way?

Answer 1

Here's a different approach which is fairly fast:
Sub Lister()
Dim t, i, m, arr, rng, dict As Object, dictDupes As Object, usr, v
Set dict = CreateObject("scripting.dictionary")
Set dictDupes = CreateObject("scripting.dictionary")
Set rng = Range("A1:A500000")
'create some dummy data (0.5M rows)
With rng
.Formula = "=""USER_"" & ROUND(RAND()*5000,0) & ""_"" & ROUND(RAND()*3000,0)"
.Value = .Value
End With
t = Timer
arr = rng.Value
For i = 1 To UBound(arr, 1)
usr = arr(i, 1)
If Not dict.exists(usr) Then
dict.Add usr, i
Else
If Not dictDupes.exists(usr) Then dictDupes.Add usr, dict(usr)
dictDupes(usr) = dictDupes(usr) & "|" & i
End If
Next i
For Each usr In dictDupes
v = dictDupes(usr)
'Debug.Print "----" & usr & "---"
'Debug.Print Join(Split(v, "|"), ", ")
Next usr
Debug.Print dict.Count, dictDupes.Count
Debug.Print "Done in", Timer - t
End Sub
Completes in about 20-25 sec
Another note:
If you want to use Match then it's significantly faster to leave your data on the worksheet instead of running Match against an array.
Sub TestMatch()
Dim t, i, m, arr, rng
Set rng = Range("A1:A50000")
With rng
.Formula = "=ROUND(RAND()*30000,0)"
.Value = .Value
End With
t = Timer
For i = 1 To 10000
m = Application.Match(i, rng, 0)
Next i
Debug.Print "sheet", Timer - t
arr = rng.Value
t = Timer
For i = 1 To 10000
arr = rng.Value
m = Application.Match(i, arr, 0)
Next i
Debug.Print "array", Timer - t
End Sub
Output:
sheet 3.644531
array 131.9453
So the array is about 35x slower.

Answer 2

Thanks to Tim I got a solution going:
Dim dict As Dictionary
Set dict = CreateObject("scripting.dictionary")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set UserRange = Range(Cells(2, 11), Cells(LastRow, 11))
For Each cell In UserRange
dict(cell.value) = dict(cell.value) + 1
Next
Debug.Print "Number of users: " & dict.Count
t = Timer
For Each User In dict
Set Profile = New UserProfile
Profile.Count = dict(User)
Dim UserIndex() As Variant
ReDim UserIndex(1 To dict(User))
For i = 1 To dict(User)
Row = WorksheetFunction.Match(User, UserRange, 0)
UserIndex(i) = Row
Next
For i = LBound(UserIndex) To UBound(UserIndex)
Dim Purchase() As Variant
ReDim Purchase(1 To LastCol) As Variant
Purchase = Range(Cells(UserIndex(i) + 1, 1), Cells(UserIndex(i) + 1, LastCol))
Profile.Add Purchase
Next
Next
Debug.Print "Match/Index loop completed in ", Timer - t
Turns out that matching on a range instead of an array is much faster. And so is reading from a range instead of performing an WorksheetFunction.Index on an array. These results were both unexpected to me, as I thought reading/writing to the workbook generally slows things down. I also added a (1 , to thePurchase array readouts in my UserProfile class in order to ditch the Transpose.
Profiling for the whole 55K dataset completed in only 23 seconds!