Matches Game Source Code

Published on .
Updated on .
by Techronology
Matches game source code - Techronology

Overview of our Matches game

For the most part, our Matches game is standard matching play for Excel. We list the VBA source code here separately. Thus, feel free to explore this code listing. Perhaps, you will find it useful in one of your projects. Although it looks pretty much clean, we notice there are no comments.

Below is the code that drives the engine.

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

Here is partial code that responds to user interaction with one of the pieces. So, each piece on the board calls the Check_Match subroutine when clicked.

Option Explicit
Option Private Module

Public Sub boxC6()
    Call Sheet1.Check_Match("C6")
End Sub

Related