Follow us:

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.

Download Excel spreadsheet (as demonstrated below)

Microsoft Excel

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:

Microsoft Excel

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

Microsoft Excel

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).

Microsoft Excel

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)
               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"
               Counts(LItem, 3) = CStr(CInt(Counts(LItem, 3)) + 1)
            End If
         Next k
      Next j
   Next i
   'Paste pairs onto sheet called PairStats
   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"
   Selection.Font.Bold = True
   Selection.Font.Underline = xlUnderlineStyleSingle
   Range("F1").FormulaR1C1 = "Last Updated on " & Now()
   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.