Matches desktop game for Excel

Overview of Matches

So, Matches is our third matching game in the AS3rd collection. As with Wingding Match, it uses characters or pieces from the Wingding font. Although this game is older than Wingding, it is probably more challenging.

To win the game, you have to make a match 24 times. It is just a straightforward matching game. Also, the pieces are randomized for each game, which will keep you on your toes.

A great game to play at home or in the office. Enjoy!

Play the game

Requirements to play Matches – Microsoft Excel 2003 or higher or compatible.

Download the game

Complete the game

When you complete the game, this is how it looks. Um, um, um. Can you complete the task?

Code listing

Option Explicit

Public attempts As Integer
Public matchChr As Variant
Public matchCnt As Integer
Public matchNum As Integer
Public randChr As Variant
Public score As Integer
Dim matchPick(3) As String
Dim matchPos(48) As Integer

Private Sub Assign_Positions()
    Dim i As Integer
    Dim prevNum, randNum As Integer
    
    prevNum = 0
    randNum = 0
    
    i = 0
    Do While i <= 23
        Randomize
        
        randNum = Int(Rnd * 48)
        
        If (matchPos(randNum) <> 1) Then
            matchPos(randNum) = 1
            i = i + 1
        End If
    
        prevNum = randNum
    Loop
End Sub

Public Sub Check_Match(boxNum As String)
    matchNum = matchNum + 1
    matchPick(matchNum) = boxNum
    
    If (matchNum < 3) Then
        Shapes("box" & matchPick(matchNum)).Visible = False
    Else
        matchNum = 0
        Shapes("box" & matchPick(1)).Visible = True
        Shapes("box" & matchPick(2)).Visible = True
    End If
    
    If (matchNum = 2) Then
        Call TimeDelay(1)
        
        If (Range(matchPick(1)).Value = Range(matchPick(2)).Value) Then
            score = score + 100
            matchCnt = matchCnt + 1
            matchNum = 0
                
            Shapes("box" & matchPick(1)).Visible = False
            Shapes("box" & matchPick(2)).Visible = False
        Else
            score = score - 10
            attempts = attempts + 1
            matchNum = 0
            Shapes("box" & matchPick(1)).Visible = True
            Shapes("box" & matchPick(2)).Visible = True
        End If
    End If
    
    If (matchCnt = 24) Then
        Range("E3").Value = "Final Score: " & score
        Range("G4").Value = "Matches: " & matchCnt
    Else
        Range("E3").Value = "Score: " & score
        Range("E4").Value = "Attempts: " & attempts
        Range("G4").Value = "Matches: " & matchCnt
    End If
End Sub

Private Sub Clear_Match_Positions()
    Dim i, j As Integer
    
    For i = 0 To 47                                         'initialize match positions
        matchPos(i) = 0
    Next

    For i = 0 To 5                                          'clear cell values
        For j = 0 To 7
            Range(Chr(67 + j) & (6 + i)).Value = ""
        Next
    Next
End Sub

Private Sub Initialize()
    matchChr = Array(33, 37, 38, 40, 41, 43, 46, 68, 72, 93, 94, 108, 110, 115, 117, 118, 162, 164, 168, 171, 182, 220, 234, 242)
    matchCnt = 0
    matchNum = 0
    
    attempts = 0
    score = 0

    Range("E3").Value = "Score: " & score
    Range("E4").Value = "Attempts: " & attempts
    
    Range("F13").Select
End Sub

Private Sub Place_Match_Chars()
    Dim i, j As Integer
    Dim mNum1, mNum2, pNum As Integer
    
    mNum1 = 0    'match number
    mNum2 = 0    'position number
    pNum = 0     'character number
    
    For i = 0 To 5
        For j = 0 To 7
            If (matchPos(pNum) = 1) Then
                Range(Chr(67 + j) & (6 + i)).Value = Chr(matchChr(mNum1))
                mNum1 = mNum1 + 1
            Else
                Range(Chr(67 + j) & (6 + i)).Value = Chr(randChr(23 - mNum2))
                mNum2 = mNum2 + 1
            End If
            
            pNum = pNum + 1
        Next
    Next
End Sub

Private Sub Randomize_Match_Chars()
    Dim i, j As Integer
    Dim tmp As Integer
    Dim tmpArr As Variant
    
    tmpArr = matchChr

    Randomize
    
    For i = 0 To 23
        j = Int(i + Rnd * (23 - i + 1))
    
        tmp = tmpArr(i)
        tmpArr(i) = tmpArr(j)
        tmpArr(j) = tmp
    Next
    
    randChr = tmpArr
End Sub

Private Sub TimeDelay(secs As Integer)
    Dim startTime
    
    startTime = Timer
    Do While Timer < startTime + secs
        DoEvents
    Loop
End Sub

Public Sub Show_Buttons()
    Dim i, j As Integer
    
    For i = 0 To 5
        For j = 0 To 7
            Shapes("box" & Chr(67 + j) & (6 + i)).Line.ForeColor.SchemeColor = 48
            Shapes("box" & Chr(67 + j) & (6 + i)).Fill.ForeColor.SchemeColor = 48
            Shapes("box" & Chr(67 + j) & (6 + i)).Visible = True
        Next
    Next
End Sub
    
Public Sub Start_Game()
    Call Initialize
    Call Randomize_Match_Chars
    Call Clear_Match_Positions
    Call Assign_Positions
    Call Show_Buttons
    Call Place_Match_Chars
End Sub

Private Sub Worksheet_Activate()
    Call Start_Game
End Sub

Games home

Overview of Matches

Play the game

Complete the game

Code listing

Related