This code load a 40MB txt into a dictionary. It runs in about 40 seconds (sometimes 20, no idea why). Is there a way to make it run under 4 seconds, or hopefully in 1 second?

Sub ScriptDic()

Dim FileNum As Integer
Dim DataLine As String
Dim tmp As Variant
Dim Dict As Object
Dim duplicatecount As Object
Dim key As String
Dim count As Long

Set Dict = CreateObject("Scripting.Dictionary")
Set duplicatecount = CreateObject("Scripting.Dictionary")

Sheets("Control").Cells(5, 3).Value2 = Now
Filename = "C:\Users\MyFolder\Documents\PerformanceTests\MyData.txt"
FileNum = FreeFile()

Open Filename For Input As #FileNum
While Not EOF(FileNum)
Line Input #FileNum, DataLine ' read in data 1 line at a time
tmp = Split(DataLine, Chr(9))
key = tmp(7) & "-" & tmp(8)
If Not Dict.exists(key) Then
Else
count = duplicatecount(key)
duplicatecount.Remove (key)

Dict.Add key & ">" & count, tmp
End If
Wend

Sheets("Control").Cells(6, 3).Value2 = Now
End Sub

• How long does it take to simply read the 40GB file? Have you benchmarked it with only the file operations (no dictionaries)? – Comintern Sep 13 '16 at 22:17
• Just read line by line takes 1 second. – BuckTurgidson Sep 13 '16 at 23:24
• Are you sure your system can load a 40 GigaByte file in 1 second? A really fast SSD can theoretically read up to 2500MB/s, but reading 40GB in 1 second would be 16 times faster than that. Do you perhaps mean a 40MB file? – ThunderFrame Sep 14 '16 at 8:11

I assume you're working with a 40MB file instead of a 40GB file. The performance will vary greatly depending upon:

• the length of each line in the file
• the number of lines in the file
• the number of uniquely keyed-lines in the file

I've worked with a contrived data-file that is 5.127MB in size and has 250,000 data rows like:

a   b   c   d   e   f   g   h   i   j
b   c   d   e   f   g   h   i   j   k
a   b   c   d   e   f   g   h   i   j


The file has nearly all duplicated records, so I'm pushing the limits on the unique key approach. A file with all unique values will perform differently.

Using your code against the 5MB file, it runs in 6.18s. If I only read the file, it reads in 0.11s. If I only read the file, split each line and build a key, it runs in 0.76s. So approximately 5.42s, or 88% of the duration is related to dictionary manipulation.

So, what can we do in VBA, to improve your code

Option Explicit You haven't included it in your code, so I assume it isn't declared.

Declare filename As String The filename variable isn't declared, although you may have declared it at global scope. Option Explicit shows e this right away.

Dim filename As String


Declare tmp as a String Array tmp is assigned with the Split function, which returns a String array, so declare tmp accordingly and you'll use a great deal less memory.

Dim tmp() As String


Early Binding You're using CreateObject("Scripting.Dictionary"), so your code will fail anyway, if Microsoft Scripting Runtime isn't available. But more importantly, by using late-binding, COM has to work harder to find the methods you're using. It's much better to early-bind by adding a reference to Microsoft Scripting Runtime.:

Dictionary variable names You've used ambiguous names: Dict and duplicatecount. You'd be better off with more meaningful names (I don't know what your data is, so I'm using less un-meaningful names) like:

Dim allRecords As Scripting.Dictionary
Dim uniqueKeyCounts As Scripting.Dictionary

Set allRecords = New Scripting.Dictionary
Set uniqueKeyCounts = New Scripting.Dictionary


Avoid using magic function/literal values You're referring to the Tab character Chr(9) which incurs time on every line. VBA has a built-in constant for Tab: vbTab, which makes it more efficient and easier to read.

tmp = Split(DataLine, vbTab)


Unique keys and Dictionary usage The code to build a unique key and populate the dictionaries is the most expensive, so let's be careful about checking the smallest dictionary more frequently than the large dictionary.

Also, there's no need to Remove and then Add back, when we can just increment the count of the existing entry.

If uniqueKeyCounts.Exists(key) Then
'Retrieve the current count once
Dim currentCount As Long
currentCount = uniqueKeyCounts.Item(key)
allRecords.Add key & ">" & currentCount, DataLine
'Don't remove and re-add, just increment the counter
uniqueKeyCounts(key) = currentCount + 1
Else
End If


Close the file You've opened the file and read it all, but you've forgotten to close the file:

Close #FileNum


Timing events Using Now() offers very limited granularity. Timer gives you improved granularity but also a few problems when timed-code runs through midnight, but it avoids the need for win32 functions. If you want better timing see GetTickCount, or better still, QueryPerformanceCounter. I've used Timer for the sake of simplicity.

Dim start As Double
start = Timer
'...Do stuff...
Debug.Print Timer - start


So, when I put it altogether, the file is read in 4.85s, or about 22% faster.

Sub ScriptDic()

'Declare fileName
Dim filename As String

Dim FileNum As Integer
Dim DataLine As String
'Declare tmp as a string array
Dim tmp() As String
'Declare as Scripting.Dictionary to get early-binding benefits
Dim allRecords As Scripting.Dictionary
Dim uniqueKeyCounts As Scripting.Dictionary
Dim key As String
Dim count As Long

'USe early binding
Set allRecords = New Scripting.Dictionary
Set uniqueKeyCounts = New Scripting.Dictionary

Sheets("Control").Cells(5, 3).Value2 = Now
filename = "C:\Temp\test100k.txt"
FileNum = FreeFile()

Dim start As Double
start = Timer
Open filename For Input As #FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, DataLine ' read in data 1 line at a time
'USe the vbTab constant
tmp = Split(DataLine, vbTab)
key = tmp(7) & "-" & tmp(8)
'Check the unique dictionary - it's almost always smaller
If uniqueKeyCounts.Exists(key) Then
'Retrieve the current count once
Dim currentCount As Long
currentCount = uniqueKeyCounts.Item(key)
allRecords.Add key & ">" & currentCount, DataLine
'Don't remove and re-add, just increment the counter
uniqueKeyCounts(key) = currentCount + 1
Else
End If
Loop

'Close the file
Close #FileNum

Debug.Print Timer - start
Sheets("Control").Cells(6, 3).Value2 = Now
End Sub


But do you really want a Dictionary? Using the existing and optimized approach, you'll end up with a dictionary that is keyed by what seems to be an arbitrary index. You may have your reasons, but if you're not going to use the features of a dictionary, you might be better off with an array:

This code runs in just 1.56s.

Sub ScriptDic1()

'Declare fileName
Dim filename As String

Dim FileNum As Integer
Dim DataLine As String
'Declare tmp as a string array
Dim tmp() As String
'Declare as Scripting.Dictionary to get early-binding benefits
Dim uniqueKeyCounts As Scripting.Dictionary
Dim key As String
Dim count As Long

Dim lineNumber As Long

'Create an array that is larger than our needs, we'll resize it when we're done.
ReDim allRecords(1, 500000) As Variant

'USe early binding
Set uniqueKeyCounts = New Scripting.Dictionary

Sheets("Control").Cells(5, 3).Value2 = Now
filename = "C:\Temp\test100k.txt"
FileNum = FreeFile()

Dim start As Double
start = Timer
Open filename For Input As #FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, DataLine ' read in data 1 line at a time
'USe the vbTab constant
tmp = Split(DataLine, vbTab)
key = tmp(7) & "-" & tmp(8)
'Check the unique dictionary - it's going to be smaller
If uniqueKeyCounts.Exists(key) Then
'Retrieve the current count once
Dim currentCount As Long
currentCount = uniqueKeyCounts.Item(key)
allRecords(0, lineNumber) = key & ">" & currentCount
allRecords(1, lineNumber) = tmp
'Don't remove and re-add, just increment the counter
uniqueKeyCounts(key) = currentCount + 1
Else
allRecords(0, lineNumber) = key
allRecords(1, lineNumber) = tmp
End If
lineNumber = lineNumber + 1
Loop

ReDim Preserve allRecords(1, lineNumber - 1) As Variant
'Close the file
Close #FileNum

Debug.Print Timer - start
Sheets("Control").Cells(6, 3).Value2 = Now
End Sub

• ok this is impressive. minor but interesting improvement aside, the fact that we skip 'remove' made my case run 3x faster. I do need to randomly access these record afterwards (in the case when the key has meaning = is unique) which is something like 2/3rds of the data. However your question in second example made me realize that when the key is not unique and has no meaning I can just use a count as index – BuckTurgidson Sep 14 '16 at 20:47
• Here the final numbers: Old code was running at 15 sec today (no idea why). Final code (basically ScriptDic in the answer) runs in 5 sec. That compared with 3.7 seconds just to loop the file (0.6 sec), split and build key. So 1-1.5 secs to put the data into a dictionary. – BuckTurgidson Sep 14 '16 at 21:18
• I'm wondering if I can make 5 seconds down to less then 1 second if I go down the C# path... – BuckTurgidson Sep 14 '16 at 21:29