Excel VBA - Count unique/distinct values in Column A based on criteria in Column B

Question

I have a working sample of code below, which copies data from one workbook to another workbook. It checks the value in Column C of the 'FROM' workbook and counts the distinct unique values in Column C and outputs that count/value in the second workbook cell.

All good so far.

My problem is, I have been trying to adapt the code below to also look at Column F, to check if a value equals a specific criteria, and then only count the items in column C that have that cirteria in column F.

Sub CopyDataFromSourceFile()

Dim wbFrom As Workbook
Dim wbTo As Workbook
Dim Listcount As String
Dim LstRw As Long, Rng As Range, List As Object

LstRw = Cells(Rows.Count, "C").End(xlUp).Row
Set List = CreateObject("Scripting.Dictionary")

For Each Rng In Range("C9:C" & LstRw)
  If Not List.Exists(Rng.Value) Then List.Add Rng.Value, Nothing
Next

'MsgBox "There are " & List.Count & " unique values"

Listcount = List.Count


wbFrom.Sheets("Sheet1").Range("B3").Copy

wbTo.Sheets("Sheet1").Range("A1").PasteSpecial
wbTo.Sheets("Sheet1").Range("D4").Value = Listcount

wbTo.Activate


End Sub

Some Data:

1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30340
1900 CUMBERLAND PKWY SE ATLANTA GA  30341
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1901 CUMBERLAND PKWY SE     GA  30340
1902 CUMBERLAND PKWY SE     GA  30341

Notice the address and zip code changes. I want to count unique values in Column C (the unique count of address) if and only if the zip code equals 30339.

So the final result of the example above should be 12 out of the 16 records.

Answer 1

Add a check for 30339:

For Each Rng In Range("C9:C" & LstRw)
  If Rng.Offset(0,3) = 30339 Then
    If Not List.Exists(Rng.Value) Then List.Add Rng.Value, Nothing
  End If
Next

Bonus tip to speed it up: read Range(C9:F & LstRw) in as a variant array before building the dictionary (see http://www.cpearson.com/excel/ArraysAndRanges.aspx ).