# MS Excel: Counting matched pairs in Excel 2003/XP/2000/97

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.

Download Excel spreadsheet (as demonstrated below)

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) C.Add C.Count + 1, LDesc '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 'Format headings 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.