Why You Need Keyed Storage

The problem arrays cannot solve neatly

An array is brilliant when you know where something is: row 412, column 3. It is hopeless when the question is have I seen customer 88431 before? Answering that means walking through everything collected so far — a loop inside a loop, whose cost grows with the square of the row count. Ten times the data, a hundred times the work.

What a nested search really costs

This finds unique values the slow way. With 10,000 rows it makes roughly fifty million comparisons, and it is what almost everyone writes first:

Sub UniqueTheSlowWay()
    Dim data As Variant
    Dim seen() As String
    Dim r As Long, i As Long, n As Long
    Dim found As Boolean

    data = Range("A2:A10001").Value
    ReDim seen(1 To UBound(data, 1))

    For r = 1 To UBound(data, 1)
        found = False
        For i = 1 To n
            If seen(i) = CStr(data(r, 1)) Then
                found = True
                Exit For
            End If
        Next i
        If Not found Then
            n = n + 1
            seen(n) = CStr(data(r, 1))
        End If
    Next r

    Debug.Print n & " unique values"
End Sub

A keyed store answers instantly

A Dictionary stores things under a key you choose, and a lookup costs the same tiny amount of time whether it holds ten entries or a million. The inner loop disappears.

A duplicate checker you can use today

Here is that idea as something finished. Paste it into a normal module and run ListDuplicates. It creates a small Key Demo sheet if you have none, reads column A, and writes a Duplicate Report listing every value that appears more than once, how often, and on which rows. Point it at a real customer or article list and it does in a second what an eye-and-highlighter pass does in an hour.

Option Explicit

Sub ListDuplicates()
    Dim ws As Worksheet
    Dim report As Worksheet
    Dim counts As Object
    Dim rowsFor As Object
    Dim data As Variant
    Dim lastRow As Long
    Dim r As Long
    Dim k As Variant
    Dim key As String
    Dim outRow As Long

    Set ws = DemoSheet()
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then Exit Sub

    data = ws.Range("A2:A" & lastRow).Value

    Set counts = CreateObject("Scripting.Dictionary")
    Set rowsFor = CreateObject("Scripting.Dictionary")
    counts.CompareMode = vbTextCompare
    rowsFor.CompareMode = vbTextCompare

    For r = 1 To UBound(data, 1)
        key = Trim$(CStr(data(r, 1)))
        If Len(key) > 0 Then
            counts(key) = counts(key) + 1
            If counts(key) = 1 Then
                rowsFor(key) = CStr(r + 1)
            Else
                rowsFor(key) = rowsFor(key) & ", " & (r + 1)
            End If
        End If
    Next r

    Set report = SheetNamed("Duplicate Report")
    report.Cells.Clear
    report.Range("A1:C1").Value = Array("Value", "Times", "Rows")
    report.Range("A1:C1").Font.Bold = True

    outRow = 1
    For Each k In counts.Keys
        If counts(k) > 1 Then
            outRow = outRow + 1
            report.Cells(outRow, 1).Value = k
            report.Cells(outRow, 2).Value = counts(k)
            report.Cells(outRow, 3).Value = rowsFor(k)
        End If
    Next k

    report.Columns("A:C").AutoFit
    report.Activate

    MsgBox (lastRow - 1) & " rows read." & vbCrLf & _
           counts.Count & " distinct values." & vbCrLf & _
           (outRow - 1) & " of them appear more than once.", _
           vbInformation, "Duplicate check"
End Sub

Private Function DemoSheet() As Worksheet
    Dim ws As Worksheet
    Dim names As Variant
    Dim i As Long

    Set ws = SheetNamed("Key Demo")
    If ws.Range("A1").Value <> "" Then
        Set DemoSheet = ws
        Exit Function
    End If

    ws.Range("A1").Value = "Customer"
    ws.Range("A1").Font.Bold = True

    ' Note the stray trailing space and the lower-case entry.
    names = Array("Meier AG", "Brunner", "Steiner GmbH", "Meier AG", _
                  "Keller", "brunner", "Steiner GmbH ", "Waber", _
                  "Meier AG", "Keller", "Zumbrunnen", "Steiner GmbH")

    For i = LBound(names) To UBound(names)
        ws.Cells(i + 2, 1).Value = names(i)
    Next i

    ws.Columns("A").AutoFit
    Set DemoSheet = ws
End Function

Private Function SheetNamed(ByVal sheetName As String) As Worksheet
    Dim ws As Worksheet
    Dim found As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = sheetName Then Set found = ws
    Next ws

    If found Is Nothing Then
        Set found = ThisWorkbook.Worksheets.Add
        found.Name = sheetName
    End If

    Set SheetNamed = found
End Function

Line by line

• The whole column is read at once with data = ws.Range(…).Value, so the sheet is touched once rather than once per row.
• counts(key) = counts(key) + 1 is the pattern to memorise. Reading a key that does not exist yet returns Empty, and Empty + 1 is 1, so nothing needs initialising. That behaviour also has a sharp edge, which lesson three covers.
• The second dictionary, rowsFor, collects the row numbers under the same key — r + 1 because the array starts at sheet row 2.
• counts.Keys returns every key in the order it was first seen, so the report follows the data.
• SheetNamed creates a sheet only if it is missing, so repeated runs do not leave you with Duplicate Report (2).
• One pass does all of it. Add a zero to the row count and this takes ten times as long, not a hundred.

The trap: two keys that look identical

A key matches only if it is exactly the same. "Steiner GmbH " with a trailing space from a web export and "Steiner GmbH" typed by a colleague are two different keys — so the report comes back empty while you stare at two obviously identical rows. Capitalisation does the same unless you say otherwise. The demo data contains both faults deliberately, which is why the macro trims every key and sets the compare mode first:

Set counts = CreateObject("Scripting.Dictionary")
counts.CompareMode = vbTextCompare       ' before the first key goes in
key = Trim$(CStr(data(r, 1)))            ' text, and no stray spaces
counts(key) = counts(key) + 1

The two tools in this course

• Collection — built into VBA, available everywhere including Excel for Mac, holds an ordered list with optional keys. Simple, and limited: it cannot tell you whether a key exists without an error handler.
• Scripting.Dictionary — a Windows-only component. It stores key and item pairs, can be asked whether a key exists, lists its keys, and lets you change an item in place. On macOS it does not exist, so a Collection has to stand in.
• Rule of thumb — for an ordered list, a Collection. To look things up, count or group them, a Dictionary.

How it goes on

The next lessons take both containers apart: what a Collection can and cannot do, the full Dictionary member list including the behaviour that silently corrupts counts, and late binding with CreateObject versus early binding with a reference. Then come the recipes — counting and grouping rows in one pass, matching two lists against each other, and storing whole records behind a key instead of one number.