# MS Excel 2003: Counting matched pairs

This Excel tutorial explains how to write a macro to count the number of matching pairs in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Microsoft Excel 2003/XP/2000/97, I have a spreadsheet that contains the winning numbers for a lottery. I'd like to count the number of times a pair of numbers occurs in the various draws. How can I do this?

Answer: This can be done using VBA code to generate the matched pair counts and then the VLOOKUP function to move the results into a matrix.

Let's look at an example.

In this example spreadsheet, we have a sheet called "Draw Data" that contains the winning numbers for several draws. On this sheet is a button called "Update Pair Stats" that calls a macro called UpdatePairStats.

When the macro runs, it will populate a sheet called "PairStats" with the matched pair counts as follows:

When the macro has completed, the following message box will appear:

On the sheet called Pairs, you will see that the matrix has been filled in with the matched pair counts (based on a VLOOKUP formula).

The matrix uses the following formula (cell C2 contains the following formula):

`=IF(ISNA(VLOOKUP(Pairs!\$A2 & "." &Pairs!C\$1,PairStats!\$A:\$D,4,FALSE)),"",VLOOKUP(Pairs!\$A2 & "." &Pairs!C\$1,PairStats!\$A:\$D,4,FALSE))`

What this formula does is perform a VLOOKUP for the concatenated numbers (separated with a "."). If no match is found, it returns an empty string ("").

You can press Alt-F11 to view the VBA code.

## Macro Code

The macro code looks like this: (and is found in Module1)

```Sub UpdatePairStats()

Dim LRange As Variant
Dim LRows As Long
Dim LCols As Long
Dim C As New Collection
Dim LItem As Long
Dim LDesc As String
Dim Counts(10000, 4) As String
Dim i As Long, j As Long, k As Long

On Error Resume Next

'Select sheet where data resides
Sheets("Draw Data").Select

'Data range (where draw information resides)
LRange = Range("C2:H1151")

LRows = UBound(LRange, 1)
LCols = UBound(LRange, 2)

'Loop through each row in LRange (find pairs)
For i = 1 To LRows

'j and k create the pairs
For j = 1 To LCols - 1

For k = j + 1 To LCols
'Separate pairs with a "." character (smaller number first)
If LRange(i, j) < LRange(i, k) Then
LDesc = LRange(i, j) & "." & LRange(i, k)
Else
LDesc = LRange(i, k) & "." & LRange(i, j)
End If

'Add new item to collection ("on error resume next" is
'required above in this procedure because of this line of code)

'Retrieve indexnumber of new item
LItem = C(LDesc)

'Add pair information to new item
If Counts(LItem, 0) = "" Then
Counts(LItem, 0) = LDesc
Counts(LItem, 1) = LRange(i, j)
Counts(LItem, 2) = LRange(i, k)
End If

'Increment stats counter
If Counts(LItem, 3) = "" Then
Counts(LItem, 3) = "1"
Else
Counts(LItem, 3) = CStr(CInt(Counts(LItem, 3)) + 1)
End If

Next k
Next j
Next i

'Paste pairs onto sheet called PairStats
Sheets("PairStats").Select
Cells.Select
Selection.Clear
Cells(1, 1).Resize(C.Count, 4) = Counts

Range("A1").FormulaR1C1 = "'Number1.Number2"
Range("B1").FormulaR1C1 = "'Number1"
Range("C1").FormulaR1C1 = "'Number2"Range("D1").FormulaR1C1 = "'Occurrences"

Range("A1:D1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle

Columns("A:D").EntireColumn.AutoFit
Range("F1").Select
Range("F1").FormulaR1C1 = "Last Updated on " & Now()

Sheets("Pairs").Select
MsgBox "Pair statistics have been updated."

End Sub```

Please note that you will have to customize the LRange variable to match the number of rows and columns for your data.

Share: