Wingding Match game (or WMG) for Excel
Requirements
Microsoft Excel 2003 or higher or compatible.
Wingding Match
Below is a video showcasing realtime play of WMG.
Wingding Match is a desktop game for Microsoft Excel. Overall, it has three levels. And, there is one twist to this game. If you miss consecutive matches, then the pieces are shuffled again.
Now, the shuffling feature is okay for the amount of pieces in this game.
So, we do not offer support for this game and most items in our vintage collection. In order to play this game, you must enable macros in Excel.
Known bug in Wingding Match
There is a known bug in WMG. You see, when a level loads, somethings you see the placement of the characters before they are hidden. Um, um, um. If you want to fix it, then view the code (Alt + F11) to the game in Excel.
Or, you can view the code listing right here.
The levels
On the whole, there are three levels to this game. Below are screenshots of the three levels.
First level
Second level
Third level
Requirements
Microsoft Excel 2003 or higher or compatible.
Code listing
Below, is the code listing to Wingding Match.
'wingding_match.xls
'Designed and programmed by: Alex Shaw III
'Date created: August 31, 2008
'Last modified: September 11, 2008
'Note: Printout in landscape mode for clarity
Option Explicit 'require declaration
Option Base 1 'start array allocation at one
Public appVer As String 'application version
Public cellRefs As Variant 'cell reference locations
Public conMiss As Integer 'consecutive misses
Public levelAtts As Integer 'level attempts
Public levelMax As Variant 'maximum boxes per level
Public levNum As Integer 'level number
Public matchChars As Variant 'match characters
Public matchCount As Integer 'match count
Public missBonus As Integer 'miss bonus
Public pickCount As Integer 'pick count
Public score As Long 'score
Public totalAtts As Integer 'total attempts
Dim gameChars(1 To 6) As Integer 'game characters for up to 12 matches
Dim pickChar(1 To 2) As String 'pick character
Public Sub matchBoxB16()
Call Check_Match("B16")
End Sub
Public Sub matchBoxC13()
Call Check_Match("C13")
End Sub
Public Sub matchBoxC17()
Call Check_Match("C17")
End Sub
Public Sub matchBoxD7()
Call Check_Match("D7")
End Sub
Public Sub matchBoxD11()
Call Check_Match("D11")
End Sub
Public Sub matchBoxD15()
Call Check_Match("D15")
End Sub
Public Sub matchBoxD19()
Call Check_Match("D19")
End Sub
Public Sub matchBoxE12()
Call Check_Match("E12")
End Sub
Public Sub matchBoxE16()
Call Check_Match("E16")
End Sub
Public Sub matchBoxF10()
Call Check_Match("F10")
End Sub
Public Sub matchBoxF14()
Call Check_Match("F14")
End Sub
Public Sub matchBoxG12()
Call Check_Match("G12")
End Sub
Private Sub Calc_Level_Points(addSub As Integer, ParamArray lev() As Variant)
If (addSub = 0) Then 'add to score
Select Case levNum 'calculate score based on level
Case 1: score = score + lev(0) 'level 1 and consecutive miss increase
Case 2: score = score + lev(1) 'level 2 and consecutive miss increase
Case 3: score = score + lev(2) 'level 3 and consecutive miss increase
End Select
Else 'subtract from Score
Select Case levNum 'calculate score based on level
Case 1: score = score - lev(0) 'level 1
Case 2: score = score - lev(1) 'level 2
Case 3: score = score - lev(2) 'level 3
End Select
End If
Range("score").Value = score 'display score
End Sub
Private Sub Check_Match(cellRef As String)
If (Shapes("matchBox" & cellRef).Visible = True) Then 'check to see if box is visible
pickCount = pickCount + 1 'increment pick count
pickChar(pickCount) = cellRef 'pick character
Call Calc_Level_Points(0, 25, 50, 75) 'calculate level points
If (pickCount < 3) Then Shapes("matchBox" & cellRef).Visible = False 'hide match box
If (pickCount = 2) Then
Call Time_Delay(0.5) 'pause for a half-second
pickCount = 0 'start new pick count
If (Range(pickChar(1)).Value = Range(pickChar(2)).Value) Then 'match was found
Call Display_Message("Match found!") 'display match message
Call Calc_Level_Points(0, 500, 1000, 1500) 'calculate level points
conMiss = 0 'reset consecutive misses
matchCount = matchCount + 1 'increment match count
score = score + missBonus 'apply miss bonus
Range("score").Value = score 'display score
If (matchCount = levelMax(levNum) / 2 And levNum <> 3) Then 'check for level completion
Call Display_Message("Level " & levNum & " completed!") 'display level completion message
Call Calc_Level_Points(0, 2000, 3000, 5000) 'calculate bonus points
levNum = levNum + 1 'move to next level
matchCount = 0 'start match count over
missBonus = 0 'reset miss bonus
levelAtts = levelMax(levNum) 'reset amount of level attempts
Range("attempts").Value = levelAtts 'display level attempts
Range("level").Value = "Level " & levNum 'display level number
Call Prepare_Game(levNum) 'prepare new level
ElseIf (matchCount = levelMax(levNum) / 2 And levNum = 3) Then 'check for game completion
Call Calc_Level_Points(0, 2000, 3000, 5000) 'calculate bonus points
Call Game_Over 'game over routine
End If
Else 'match was not found
Call Display_Message("Try again lucky!") 'display miss message
Call Calc_Level_Points(1, 50, 100, 150) 'subtract points from score
conMiss = conMiss + 1 'increment consecutive misses
levelAtts = levelAtts - 1 'increment level attempts
totalAtts = totalAtts + 1 'increment total attempts
Range("attempts").Value = levelAtts 'display total attempts
Shapes("matchBox" & pickChar(1)).Visible = True 'display match box for first pick
Shapes("matchBox" & pickChar(2)).Visible = True 'display match box for second pick
If (levelAtts = 0) Then
Call Game_Over 'check level attempts
End If
If (conMiss = 2 And levelAtts <> 0) Then 'check consecutive misses
Shapes("gameMes2").Visible = True 'display scrambling message box
Call Scramble 'scramble characters
ElseIf (levelAtts <> 0) Then
End If
End If
End If
Else
Call Worksheet_Activate 'restart game
End If
End Sub
Private Sub Clear_Chars()
Dim n As Integer 'counting variable
For n = 1 To UBound(cellRefs) 'check all references in game
Range(cellRefs(n)).Value = "" 'clear cell value
Next
For n = 1 To UBound(gameChars) 'assign zero to game characters
gameChars(n) = 0 'initialize game character
Next
End Sub
Private Sub Display_Message(message As String)
Range("message").Value = message 'display message
End Sub
Public Sub End_Game()
ThisWorkbook.Close SaveChanges:=False 'close game without saving
End Sub
Private Sub Game_Over()
If (matchCount = levelMax(levNum) / 2 And levNum = 3) Then 'user won
Call Display_Message("Congratulations! You have completed the game!") 'display congratulation message
score = score + 7500 'add bonus to score
Range("score").Value = score 'display bonus
Else 'user lost
Call Display_Message("Game Over! You lose! Please try again!") 'display lost message
Call Clear_Chars 'clear characters
Call Hide_Boxes(1, 12) 'hide boxes
End If
Shapes("gameMes1").Visible = True 'show game over box
End Sub
Private Sub Get_Chars()
Dim n As Integer 'counting variable
Dim randNum As Integer 'random number
Dim tmpArray As Variant 'temporary array
tmpArray = Randomize_Array(matchChars) 'randomize temporary array
Randomize
n = 1 'initialize counting variable
Do While (n < levelMax(levNum) / 2 + 1) 'select characters based on maximum matches
randNum = Int(Rnd * UBound(tmpArray)) + 1 'obtain random number
If (Int(Rnd * 3) = 2 And tmpArray(randNum) <> 0) Then 'check for open random position in temporary array
gameChars(n) = tmpArray(randNum) 'assign value from temporary array to game character
tmpArray(randNum) = 0 'assign zero to random location in temporary array
n = n + 1 'increment counting variable
End If
Loop
End Sub
Private Sub Hide_Boxes(startNum As Integer, endNum As Integer)
Dim n As Integer 'counting variable
For n = startNum To endNum 'hide only a particular range of match boxes
Shapes("matchBox" & cellRefs(n)).Visible = False 'hide match box
Next
End Sub
Private Sub Hide_Messages()
Dim n As Integer 'counting variable
For n = 1 To 2
Shapes("gameMes" & n).Visible = False 'hide game message
Next
End Sub
Private Sub Initialize()
cellRefs = Array("C17", "D7", "D11", "D15", "D19", "E12", "C13", "E16", "B16", "F10", "F14", "G12")
levelMax = Array(6, 8, 12)
matchChars = Array(33, 34, 36, 37, 38, 39, 40, 41, 43, 46, 49, 50, 53, 56, 68, 93, 94, 98, 100, 102)
appVer = Application.Version 'application version
conMiss = 0 'consecutive misses
levelAtts = 3 'level attempts
levNum = 1 'level number
matchCount = 0 'match count
missBonus = 0 'miss bonus
pickCount = 0 'pick count
score = 0 'game score
totalAtts = 0 'total attempts
Range("score").Value = score 'display score
Range("attempts").Value = levelAtts 'display attempts
Range("level").Value = "Level 1" 'display level
Range("A1").Select 'select A1 to display game board
End Sub
Public Sub Instructions()
Sheet2.Activate
End Sub
Private Sub Place_Chars()
Dim m As Integer, n As Integer, j As Integer
Dim cellArray() As String, charArray() As Integer
ReDim cellArray(levelMax(levNum)), charArray(UBound(gameChars))
For n = 1 To levelMax(levNum)
cellArray(n) = cellRefs(n) 'copy values from cell reference to cell array
Next
charArray = gameChars 'assign game characters to character array
Randomize
For m = 1 To 2
cellArray = Randomize_Array(cellArray) 'randomize match box cells
j = 1 'initialize counter
For n = 1 To UBound(cellArray) 'count each cell in cell array
If (cellArray(n) <> "" And j < levelMax(levNum) / 2 + 1) Then 'check cell in cell array
Range(cellArray(n)).Value = "'" & Chr(charArray(j)) 'assign value to cell in game
cellArray(n) = "" 'clear assigned value
j = j + 1 'increment counter
End If
Next
Next
End Sub
Private Sub Prepare_Game(gameLev As Integer)
Dim levMax As Integer 'maximum match boxes on a particular level
levMax = levelMax(gameLev) 'assign maximum boxes for chosen level
Call Hide_Messages
Call Clear_Chars
Call Hide_Boxes(1, 12)
Call Show_Boxes(1, levMax)
Call Get_Chars
Call Place_Chars
End Sub
Private Function Randomize_Array(tmpArray As Variant) As Variant
Dim m As Integer, n As Integer 'counting variables
Dim tmpVal As Variant 'hold value in array
Randomize
For m = 1 To UBound(tmpArray) 'check each value in array
n = Int(Rnd * UBound(tmpArray)) + 1 'obtain random position in array
tmpVal = tmpArray(m) 'assign original value from array
tmpArray(m) = tmpArray(n) 'swap current value with random value
tmpArray(n) = tmpVal 'assign random value with original value
Next
Randomize_Array = tmpArray 'return value
End Function
Private Sub Scramble()
Dim cellArray() As String
Dim charArray() As Integer
Dim numOfBoxes As Integer
Dim m As Integer
Dim n As Integer
Call Display_Message("You missed two times in a row. Scrambling characters!")
numOfBoxes = 0 'initialize number of boxes variable
For n = 1 To levelMax(levNum) 'check all boxes on level
If (Shapes("matchBox" & cellRefs(n)).Visible) Then numOfBoxes = numOfBoxes + 1 'count visible box
Next
ReDim charArray(1 To numOfBoxes), cellArray(1 To numOfBoxes) 'reallocate space based on visible boxes
m = 1 'initialize counting variables
For n = 1 To levelMax(levNum) 'count all visible boxes on level
If (Shapes("matchBox" & cellRefs(n)).Visible) Then 'check for visibility
charArray(m) = Asc(Range(cellRefs(n)).Value) 'assign ASCII value of cell
cellArray(m) = cellRefs(n) 'get cell reference
m = m + 1 'increment counting variable
End If
Next
charArray = Randomize_Array(charArray) 'randomize character array
cellArray = Randomize_Array(cellArray) 'randomize cell array
For n = 1 To UBound(charArray) 'check each character in character
Range(cellArray(n)).Value = "'" & Chr(charArray(n)) 'display character
Next
conMiss = 0 'reset consecutive misses variable
missBonus = missBonus + 250 'increment consecutive misses bonus
Call Time_Delay(1) 'delay game
Shapes("gameMes2").Visible = False 'hide scrambling message box
End Sub
Public Sub Show_All_Boxes()
Dim cellRef As Variant 'allocate space for each match cell reference in game
If (Range("K1").Value = "admin") Then 'only administrator can show all boxes
Call Initialize 'initialize variables
For Each cellRef In cellRefs 'check each cell reference in match cell array
Shapes("matchBox" & cellRef).Visible = True 'display match box
Next
End If
End Sub
Private Sub Show_Boxes(startNum As Integer, endNum As Integer)
Dim n As Integer 'counting variable
For n = startNum To endNum 'show a particular range of match boxes
Select Case levNum 'apply appropriate color to match boxes
Case 1
Case 2
Case 3
End Select
Shapes("matchBox" & cellRefs(n)).Visible = True 'display match box
Next
End Sub
Public Sub Start_Game()
Call Initialize 'initialize variables
Call Prepare_Game(1) 'start with level 1
Call Display_Message("Go ahead, make your match!") 'display start message
End Sub
Private Sub Time_Delay(secs As Single)
Dim startTime As Variant
startTime = Timer 'assign current time to a variable
Do While Timer < startTime + secs 'continue loop until appropriate seconds elapse
DoEvents 'allow other processes to run
Loop
End Sub
Private Sub Worksheet_Activate()
Call Start_Game
End Sub
