Excel - Visual Basic For Applications - Mastermind Game

Question

For those who are unfamiliar with the game:

https://en.wikipedia.org/wiki/Mastermind_(board_game)

A link to the workbook:

https://github.com/Evanml2030/Excel-Mastermind

Had trouble getting the form and scroll bar to adjust based on the resolution of the monitor that it is inside. It does not work on screens running with a resolution greater than 1600 x 900. See the resize me function in the form code, labeled front end, to take a look at the code.

APPLICATION:

Option Explicit
'ENUMERATED TYPES
Public Enum GamePieceColor
 rgbRed = 255
 rgbGreen = 65280
 rgbBlue = 16711680
 rgbYellow = 65535
 rgbBlack = 0
 rgbWhite = 16777215
 rgbGrey = 12632256
 rgbLightGrey = -2147483633
 rgbNone = -1
End Enum
'STRUCTS
Public Type GuessArray
 ColorOne As GamePieceColor
 ColorTwo As GamePieceColor
 ColorThree As GamePieceColor
 ColorFour As GamePieceColor
End Type
Private Type GameOver
 TrueFalse As Boolean
 Reason As String
End Type
Private Type GuessValid
 TrueFalse As Boolean
 Reason As String
End Type
Public Type ResponsePegs
 MatchesComplete As Long
 MatchesColor As Long
End Type
Public Type RequestNextColor
 Row As Long
 CurrentColor As GamePieceColor
End Type
Public Type RequestCheckGuess
 GuessArray As GuessArray
End Type
Public Type ResponseNextColor
 GuessNumber As Long
 NextColor As GamePieceColor
End Type
Public Type ResponseCheckGuess
 GuessValid As GuessValid
 GuessNumber As Long
 ResponsePegs As ResponsePegs
 GameOver As GameOver
End Type
'GLOBAL VARIABLES
Private GameOver As Boolean
Private CurrentGuessNumber As Long
Private MasterGuessArray As GuessArray
Private MasterGuessArrayVisible As Boolean
Private Const MaxGuesses = 9
'GAME LOOP
Public Sub Main()
 Dim GameSpace As GameSpace
 Set GameSpace = New GameSpace
 GameSpace.Show
End Sub
Public Sub GameLoop(ByRef GameSpace As GameSpace)
 GameOver = False
 CurrentGuessNumber = 0
 MasterGuessArray = GenerateMasterGuessArray
 MasterGuessArrayVisible = False
 Do While GameOver = False
 DoEvents
 On Error GoTo UserFormUnloaded:
 If GameSpace.Visible = False Then
 Exit Do
 End If
 GameSpace.Resize
 Loop
 Unload GameSpace
UserFormUnloaded:
End Sub
Private Function GenerateMasterGuessArray() As GuessArray
 GenerateMasterGuessArray.ColorOne = RandomColor
 GenerateMasterGuessArray.ColorTwo = RandomColor
 GenerateMasterGuessArray.ColorThree = RandomColor
 GenerateMasterGuessArray.ColorFour = RandomColor
End Function
Private Function RandomColor() As GamePieceColor
 Dim RandomNumber As Long
 RandomNumber = Application.WorksheetFunction.RandBetween(0, 5)
 Select Case RandomNumber
 Case 0
 RandomColor = rgbBlack
 Case 1
 RandomColor = rgbBlue
 Case 2
 RandomColor = rgbGreen
 Case 3
 RandomColor = rgbRed
 Case 4
 RandomColor = rgbWhite
 Case 5
 RandomColor = rgbYellow
 End Select
End Function
'GAME FUNCTIONS
Public Function GetCheckGuess(ByRef RequestCheckGuess As RequestCheckGuess) As ResponseCheckGuess
 If CheckMaxGuessesExceeded = True Then
 GameOver = True
 GetCheckGuess.GameOver.TrueFalse = True
 GetCheckGuess.GameOver.Reason = "YOU LOSE! BETTER LUCK NEXT TIME!"
 Exit Function
 End If
 If CheckGuessValid(RequestCheckGuess.GuessArray) = False Then
 GetCheckGuess.GuessValid.TrueFalse = False
 GetCheckGuess.GuessValid.Reason = "PLEASE DO NOT INCLUDE ANY GREY SQUARES IN YOUR GUESS"
 Exit Function
 End If
 GetCheckGuess = GuessValidResponseAssemble(RequestCheckGuess.GuessArray)
 CurrentGuessNumber = CurrentGuessNumber + 1
 If CheckGameWon(GetCheckGuess.ResponsePegs) = True Then
 GameOver = True
 GetCheckGuess.GameOver.TrueFalse = True
 GetCheckGuess.GameOver.Reason = "CONGRAGULATIONS, YOU WIN!"
 Exit Function
 End If
End Function
Private Function CheckMaxGuessesExceeded() As Boolean
 If CurrentGuessNumber > MaxGuesses Then
 CheckMaxGuessesExceeded = True
 Else
 CheckMaxGuessesExceeded = False
 End If
End Function
Private Function CheckGuessValid(ByRef GuessArray As GuessArray) As Boolean
 If (GuessArray.ColorOne = rgbGrey) Or _
 (GuessArray.ColorTwo = rgbGrey) Or _
 (GuessArray.ColorThree = rgbGrey) Or _
 (GuessArray.ColorFour = rgbGrey) Then
 CheckGuessValid = False
 Else
 CheckGuessValid = True
 End If
End Function
Private Function GuessValidResponseAssemble(ByRef GuessArray As GuessArray) As ResponseCheckGuess
 GuessValidResponseAssemble.GuessValid.TrueFalse = True
 GuessValidResponseAssemble.GuessNumber = CurrentGuessNumber
 GuessValidResponseAssemble.ResponsePegs = DetermineMatches(GuessArray)
End Function
Private Function CheckGameWon(ByRef ResponsePegs As ResponsePegs) As Boolean
 If ResponsePegs.MatchesComplete = 4 Then
 CheckGameWon = True
 Else
 CheckGameWon = False
 End If
End Function
Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs
 Dim TempMasterGuessArray As GuessArray
 TempMasterGuessArray = MasterGuessArray
 If GuessArray.ColorOne = TempMasterGuessArray.ColorOne Then
 GuessArray.ColorOne = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1
 End If
 If GuessArray.ColorTwo = TempMasterGuessArray.ColorTwo Then
 GuessArray.ColorTwo = rgbNone
 TempMasterGuessArray.ColorTwo = rgbNone
 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1
 End If
 If GuessArray.ColorThree = TempMasterGuessArray.ColorThree Then
 GuessArray.ColorThree = rgbNone
 TempMasterGuessArray.ColorThree = rgbNone
 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1
 End If
 If GuessArray.ColorFour = TempMasterGuessArray.ColorFour Then
 GuessArray.ColorFour = rgbNone
 TempMasterGuessArray.ColorFour = rgbNone
 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1
 End If
 If TempMasterGuessArray.ColorOne <> rgbNone Then
 If GuessArray.ColorTwo = TempMasterGuessArray.ColorOne Then
 GuessArray.ColorTwo = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorOne Then
 GuessArray.ColorThree = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorOne Then
 GuessArray.ColorFour = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 End If
 End If
 If TempMasterGuessArray.ColorTwo <> rgbNone Then
 If GuessArray.ColorOne = TempMasterGuessArray.ColorTwo Then
 GuessArray.ColorOne = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorTwo Then
 GuessArray.ColorThree = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorTwo Then
 GuessArray.ColorFour = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 End If
 End If
 If TempMasterGuessArray.ColorThree <> rgbNone Then
 If GuessArray.ColorOne = TempMasterGuessArray.ColorThree Then
 GuessArray.ColorOne = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorTwo = TempMasterGuessArray.ColorThree Then
 GuessArray.ColorTwo = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorThree Then
 GuessArray.ColorFour = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 End If
 End If
 If TempMasterGuessArray.ColorFour <> rgbNone Then
 If GuessArray.ColorOne = TempMasterGuessArray.ColorFour Then
 GuessArray.ColorOne = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorTwo = TempMasterGuessArray.ColorFour Then
 GuessArray.ColorTwo = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorFour Then
 GuessArray.ColorThree = rgbNone
 TempMasterGuessArray.ColorOne = rgbNone
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 End If
 End If
End Function
Public Function GetNextColor(ByRef RequestNextColor As RequestNextColor) As ResponseNextColor
 GetNextColor.GuessNumber = CurrentGuessNumber
 Select Case RequestNextColor.CurrentColor
 Case rgbGrey
 GetNextColor.NextColor = rgbBlack
 Case rgbBlack
 GetNextColor.NextColor = rgbBlue
 Case rgbBlue
 GetNextColor.NextColor = rgbGreen
 Case rgbGreen
 GetNextColor.NextColor = rgbRed
 Case rgbRed
 GetNextColor.NextColor = rgbWhite
 Case rgbWhite
 GetNextColor.NextColor = rgbYellow
 Case rgbYellow
 GetNextColor.NextColor = rgbBlack
 End Select
End Function
Public Function GetCurrentGuessNumber() As Long
 GetCurrentGuessNumber = CurrentGuessNumber
End Function
Public Function GetMasterRow() As GuessArray
 GetMasterRow.ColorOne = MasterGuessArray.ColorOne
 GetMasterRow.ColorTwo = MasterGuessArray.ColorTwo
 GetMasterRow.ColorThree = MasterGuessArray.ColorThree
 GetMasterRow.ColorFour = MasterGuessArray.ColorFour
End Function
Public Sub ToggleMasterGuessArrayVisible()
 MasterGuessArrayVisible = Not MasterGuessArrayVisible
End Sub
Public Function GetMasterGuessArrayVisible() As Boolean
 GetMasterGuessArrayVisible = MasterGuessArrayVisible
End Function

FRONT END:

Option Explicit
'API DECLARATIONS
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal DWORD As LongPtr) As LongPtr
Private Declare PtrSafe Function GetMonitorInfoA Lib "user32.dll" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean
'STRUCTS
Private Type RECT
 X1 As Long
 Y1 As Long
 X2 As Long
 Y2 As Long
End Type
Private Type MONITORINFOEX
 cbSize As Long
 rcMonitor As RECT
 rcWork As RECT
 dwFlags As Long
End Type
Private Type MONITORRESOLUTION
 x As Long
 Y As Long
End Type
'GLOBALS
Private Const MONITOR_DEFAULTTONEAREST = 2
'GAME LOOP INITIATE
Private Sub UserForm_Activate()
 MasterMind.GameLoop Me
End Sub
'RESIZE
Public Sub Resize()
Dim hwnd As LongPtr
Dim monitorHwnd As LongPtr
Dim returnValue As Boolean
Dim monitorInfo As MONITORINFOEX
Dim rcMonitorRec As RECT
Dim monitorRes As MONITORRESOLUTION
 hwnd = FindWindow("ThunderDFrame", Me.Caption)
 monitorHwnd = MonitorFromWindow(hwnd, MONITOR_DEFAULTTONEAREST)
 monitorInfo.cbSize = LenB(monitorInfo)
 returnValue = GetMonitorInfoA(monitorHwnd, monitorInfo)
 rcMonitorRec = monitorInfo.rcMonitor
 monitorRes.x = rcMonitorRec.X2 - rcMonitorRec.X1
 monitorRes.Y = rcMonitorRec.Y2 - rcMonitorRec.Y1
 Me.Height = (monitorRes.Y - (monitorRes.Y * 0.3955))
End Sub
'GUESS
Private Sub GuessButton_Click()
 Guess
End Sub
Private Sub Guess()
 Dim Request As RequestCheckGuess
 Dim Response As ResponseCheckGuess
 Request = AssembleRequest
 Response = MasterMind.GetCheckGuess(Request)
 MatchControlsFill Response.GuessNumber, Response.ResponsePegs.MatchesComplete, Response.ResponsePegs.MatchesColor
 HandleResponseGameOver Response
End Sub
Private Function AssembleRequest() As RequestCheckGuess
 AssembleRequest.GuessArray.ColorOne = Me.Controls.Item("A" & MasterMind.GetCurrentGuessNumber).BackColor
 AssembleRequest.GuessArray.ColorTwo = Me.Controls.Item("B" & MasterMind.GetCurrentGuessNumber).BackColor
 AssembleRequest.GuessArray.ColorThree = Me.Controls.Item("C" & MasterMind.GetCurrentGuessNumber).BackColor
 AssembleRequest.GuessArray.ColorFour = Me.Controls.Item("D" & MasterMind.GetCurrentGuessNumber).BackColor
End Function
Private Sub MatchControlsFill(ByRef Row As Long, ByRef MatchesComplete As Long, ByRef MatchesColor As Long)
 If MatchesComplete > 0 Then
 MatchesComplete = MatchesComplete - 1
 Me.Controls("Match_A" & Row).BackColor = 0
 ElseIf MatchesColor > 0 Then
 MatchesColor = MatchesColor - 1
 Me.Controls("Match_A" & Row).BackColor = 16777215
 End If
 If MatchesComplete > 0 Then
 MatchesComplete = MatchesComplete - 1
 Me.Controls("Match_B" & Row).BackColor = 0
 ElseIf MatchesColor > 0 Then
 MatchesColor = MatchesColor - 1
 Me.Controls("Match_B" & Row).BackColor = 16777215
 End If
 If MatchesComplete > 0 Then
 MatchesComplete = MatchesComplete - 1
 Me.Controls("Match_C" & Row).BackColor = 0
 ElseIf MatchesColor > 0 Then
 MatchesColor = MatchesColor - 1
 Me.Controls("Match_C" & Row).BackColor = 16777215
 End If
 If MatchesComplete > 0 Then
 MatchesComplete = MatchesComplete - 1
 Me.Controls("Match_D" & Row).BackColor = 0
 ElseIf MatchesColor > 0 Then
 MatchesColor = MatchesColor - 1
 Me.Controls("Match_D" & Row).BackColor = 16777215
 End If
End Sub
Private Sub HandleResponseGameOver(ByRef Response As ResponseCheckGuess)
 If Response.GameOver.TrueFalse = True Then
 UnhideMasterGuessArray
 MsgBox Response.GameOver.Reason
 Me.Hide
 Exit Sub
 ElseIf Response.GuessValid.TrueFalse = False Then
 MsgBox Response.GuessValid.Reason
 Exit Sub
 End If
End Sub
'BUTTON COLOR ROTATION
Private Sub A0_Click()
 RotateColor "A", 0, Me.A0.BackColor
End Sub
Private Sub B0_Click()
 RotateColor "B", 0, Me.B0.BackColor
End Sub
Private Sub C0_Click()
 RotateColor "C", 0, Me.C0.BackColor
End Sub
Private Sub D0_Click()
 RotateColor "D", 0, Me.D0.BackColor
End Sub
Private Sub A1_Click()
 RotateColor "A", 1, Me.A1.BackColor
End Sub
Private Sub B1_Click()
 RotateColor "B", 1, Me.B1.BackColor
End Sub
Private Sub C1_Click()
 RotateColor "C", 1, Me.C1.BackColor
End Sub
Private Sub D1_Click()
 RotateColor "D", 1, Me.D1.BackColor
End Sub
Private Sub A2_Click()
 RotateColor "A", 2, Me.A2.BackColor
End Sub
Private Sub B2_Click()
 RotateColor "B", 2, Me.B2.BackColor
End Sub
Private Sub C2_Click()
 RotateColor "C", 2, Me.C2.BackColor
End Sub
Private Sub D2_Click()
 RotateColor "D", 2, Me.D2.BackColor
End Sub
Private Sub A3_Click()
 RotateColor "A", 3, Me.A3.BackColor
End Sub
Private Sub B3_Click()
 RotateColor "B", 3, Me.B3.BackColor
End Sub
Private Sub C3_Click()
 RotateColor "C", 3, Me.C3.BackColor
End Sub
Private Sub D3_Click()
 RotateColor "D", 3, Me.D3.BackColor
End Sub
Private Sub A4_Click()
 RotateColor "A", 4, Me.A4.BackColor
End Sub
Private Sub B4_Click()
 RotateColor "B", 4, Me.B4.BackColor
End Sub
Private Sub C4_Click()
 RotateColor "C", 4, Me.C4.BackColor
End Sub
Private Sub D4_Click()
 RotateColor "D", 4, Me.D4.BackColor
End Sub
Private Sub A5_Click()
 RotateColor "A", 5, Me.A5.BackColor
End Sub
Private Sub B5_Click()
 RotateColor "B", 5, Me.B5.BackColor
End Sub
Private Sub C5_Click()
 RotateColor "C", 5, Me.C5.BackColor
End Sub
Private Sub D5_Click()
 RotateColor "D", 5, Me.D5.BackColor
End Sub
Private Sub A6_Click()
 RotateColor "A", 6, Me.A6.BackColor
End Sub
Private Sub B6_Click()
 RotateColor "B", 6, Me.B6.BackColor
End Sub
Private Sub C6_Click()
 RotateColor "C", 6, Me.C6.BackColor
End Sub
Private Sub D6_Click()
 RotateColor "D", 6, Me.D6.BackColor
End Sub
Private Sub A7_Click()
 RotateColor "A", 7, Me.A7.BackColor
End Sub
Private Sub B7_Click()
 RotateColor "B", 7, Me.B7.BackColor
End Sub
Private Sub C7_Click()
 RotateColor "C", 7, Me.C7.BackColor
End Sub
Private Sub D7_Click()
 RotateColor "D", 7, Me.D7.BackColor
End Sub
Private Sub A8_Click()
 RotateColor "A", 8, Me.A8.BackColor
End Sub
Private Sub B8_Click()
 RotateColor "B", 8, Me.B8.BackColor
End Sub
Private Sub C8_Click()
 RotateColor "C", 8, Me.C8.BackColor
End Sub
Private Sub D8_Click()
 RotateColor "D", 8, Me.D8.BackColor
End Sub
Private Sub A9_Click()
 RotateColor "A", 9, Me.A9.BackColor
End Sub
Private Sub B9_Click()
 RotateColor "B", 9, Me.B9.BackColor
End Sub
Private Sub C9_Click()
 RotateColor "C", 9, Me.C9.BackColor
End Sub
Private Sub D9_Click()
 RotateColor "D", 9, Me.D9.BackColor
End Sub
Private Sub RotateColor(ByRef Letter As String, ByRef Row As Long, ByRef color As GamePieceColor)
 Dim Request As RequestNextColor
 Dim Response As ResponseNextColor
 Request.CurrentColor = color
 Response = MasterMind.GetNextColor(Request)
 If Response.GuessNumber = Row Then
 Me.Controls(Letter & Row).BackColor = Response.NextColor
 Me.Controls(Letter & Row).Caption = ButtonCaption(Response.NextColor)
 Me.Controls(Letter & Row).ForeColor = ButtonFontColor(Response.NextColor)
 End If
End Sub
Private Function ButtonCaption(ByRef color As GamePieceColor) As String
 Select Case color
 Case rgbBlack
 ButtonCaption = "Black"
 Case rgbBlue
 ButtonCaption = "Blue"
 Case rgbGreen
 ButtonCaption = "Green"
 Case rgbRed
 ButtonCaption = "Red"
 Case rgbWhite
 ButtonCaption = "White"
 Case rgbYellow
 ButtonCaption = "Yellow"
 End Select
End Function
Private Function ButtonFontColor(ByRef color As GamePieceColor) As GamePieceColor
 Select Case color
 Case rgbBlack
 ButtonFontColor = rgbWhite
 Case rgbBlue
 ButtonFontColor = rgbWhite
 Case rgbGreen
 ButtonFontColor = rgbBlack
 Case rgbRed
 ButtonFontColor = rgbBlack
 Case rgbWhite
 ButtonFontColor = rgbBlack
 Case rgbYellow
 ButtonFontColor = rgbBlack
 End Select
End Function
'SHOW ANSWER
Private Sub UnhideButton_Click()
 If MasterMind.GetMasterGuessArrayVisible = True Then
 HideMasterGuessArray
 Me.UnhideButton.Caption = "UNHIDE"
 MasterMind.ToggleMasterGuessArrayVisible
 Else
 UnhideMasterGuessArray
 Me.UnhideButton.Caption = "HIDE"
 MasterMind.ToggleMasterGuessArrayVisible
 End If
End Sub
Private Sub UnhideMasterGuessArray()
 Dim MasterGuessArray As GuessArray
 MasterGuessArray = MasterMind.GetMasterRow
 Me.Master1.BackColor = MasterGuessArray.ColorOne
 Me.Master1.Caption = MasterButtonCaption(MasterGuessArray.ColorOne)
 Me.Master1.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorOne)
 Me.Master2.BackColor = MasterGuessArray.ColorTwo
 Me.Master2.Caption = MasterButtonCaption(MasterGuessArray.ColorTwo)
 Me.Master2.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorTwo)
 Me.Master3.BackColor = MasterGuessArray.ColorThree
 Me.Master3.Caption = MasterButtonCaption(MasterGuessArray.ColorThree)
 Me.Master3.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorThree)
 Me.Master4.BackColor = MasterGuessArray.ColorFour
 Me.Master4.Caption = MasterButtonCaption(MasterGuessArray.ColorFour)
 Me.Master4.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorFour)
End Sub
Private Function MasterButtonCaption(ByRef color As GamePieceColor) As String
 Select Case color
 Case rgbBlack
 MasterButtonCaption = "Black"
 Case rgbBlue
 MasterButtonCaption = "Blue"
 Case rgbGreen
 MasterButtonCaption = "Green"
 Case rgbRed
 MasterButtonCaption = "Red"
 Case rgbWhite
 MasterButtonCaption = "White"
 Case rgbYellow
 MasterButtonCaption = "Yellow"
 End Select
End Function
Private Function MasterButtonFontColor(ByRef color As GamePieceColor) As GamePieceColor
 Select Case color
 Case rgbBlack
 MasterButtonFontColor = rgbWhite
 Case rgbBlue
 MasterButtonFontColor = rgbWhite
 Case rgbGreen
 MasterButtonFontColor = rgbBlack
 Case rgbRed
 MasterButtonFontColor = rgbBlack
 Case rgbWhite
 MasterButtonFontColor = rgbBlack
 Case rgbYellow
 MasterButtonFontColor = rgbBlack
 End Select
End Function
Private Sub HideMasterGuessArray()
 Dim MasterGuessArray As GuessArray
 MasterGuessArray = MasterMind.GetMasterRow
 Me.Master1.BackColor = GamePieceColor.rgbLightGrey
 Me.Master2.BackColor = GamePieceColor.rgbLightGrey
 Me.Master3.BackColor = GamePieceColor.rgbLightGrey
 Me.Master4.BackColor = GamePieceColor.rgbLightGrey
 Me.Master1.ForeColor = rgbBlack
 Me.Master2.ForeColor = rgbBlack
 Me.Master3.ForeColor = rgbBlack
 Me.Master4.ForeColor = rgbBlack
 Me.Master1.Caption = "??"
 Me.Master2.Caption = "??"
 Me.Master3.Caption = "??"
 Me.Master4.Caption = "??"
End Sub

DETERMINE MATCHES FIXED UP:

Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs
 Dim TempMasterGuessArray As GuessArray
 Dim StartGuessArray As LongPtr
 Dim ColorGuessArray As GamePieceColor
 Dim StartTempMasterGuessArray As LongPtr
 Dim ColorTempMasterGuessArray As GamePieceColor
 Dim NullGamePieceColor As GamePieceColor
 Dim OffSetI As Long
 Dim OffsetII As Long
 NullGamePieceColor = rgbNone
 StartGuessArray = VarPtr(GuessArray)
 StartTempMasterGuessArray = VarPtr(TempMasterGuessArray)
 TempMasterGuessArray = MasterGuessArray
 For OffSetI = 0 To 12 Step 4
 CopyMemoryI VarPtr(ColorGuessArray), StartGuessArray + OffSetI, 4
 CopyMemoryI VarPtr(ColorTempMasterGuessArray), StartTempMasterGuessArray + OffSetI, 4
 If ColorGuessArray = ColorTempMasterGuessArray Then
 CopyMemoryI StartGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4
 CopyMemoryI StartTempMasterGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4
 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1
 End If
 Next OffSetI
 For OffSetI = 0 To 12 Step 4
 CopyMemoryI VarPtr(ColorGuessArray), StartGuessArray + OffSetI, 4
 If ColorGuessArray <> rgbNone Then
 For OffsetII = 0 To 12 Step 4
 CopyMemoryI VarPtr(ColorTempMasterGuessArray), StartTempMasterGuessArray + OffsetII, 4
 If ColorGuessArray = ColorTempMasterGuessArray Then
 CopyMemoryI StartGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4
 CopyMemoryI StartTempMasterGuessArray + OffsetII, VarPtr(NullGamePieceColor), 4
 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1
 Exit For
 End If
 Next OffsetII
 End If
 Next OffSetI
End Function

NEW SELECT RANDOM COLOR FUNCTION:

Private Function RandomColor() As GamePieceColor
 Dim RandomNumber As Long
 RandomNumber = Int(Rnd * 5)
 Select Case RandomNumber
 Case 0
 RandomColor = rgbBlack
 Case 1
 RandomColor = rgbBlue
 Case 2
 RandomColor = rgbGreen
 Case 3
 RandomColor = rgbRed
 Case 4
 RandomColor = rgbWhite
 Case 5
 RandomColor = rgbYellow
 End Select
End Function

• TinMan: Very nice! I love the game. I can see that you have been working hard at improving your coding skills and it is definitely paying off!!
• learnAsWeGo: @TinMan appreciate the support, this has been very fun! see the new determine matches functions in OP. I am putting up a website - bird photos, job stuff and excel posts. I will link to you when set up!!! It looks SICK :-p

Answer 1

The most obvious thing to me is the repetition in the code. I think that addressing the repetition, you can make this game scalable (change the number of guesses, change the number of pegs, change the number of colours).

Public Type GuessArray
 ColorOne As GamePieceColor
 ColorTwo As GamePieceColor
 ColorThree As GamePieceColor
 ColorFour As GamePieceColor
End Type

becomes

Public Type GuessArray
 Color(MaxPegs-1) As GamePieceColor
End Type

Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs is screaming out to be made not repetitive!

At this stage, I would consider the use of Classes instead of Types because of inherent flexibility within VBA. This requires an understanding of the objects in the game. The game consists of a Board, which holds both the MasterAnswer, and the Moves; where each move consists of a Guess [GuessArrays which are individually coloured Pegs], and the Result. Looking at the code, you already have some good bones to work with.

In removing repetition and improving both scability and maintainability, you would have to learn how to create arrays of controls in VBA Forms. For example Private Sub D9_Click() would be replaced by a function that looks a little more complicated, but only once instead of 36 times. Two websites (working as of today, cannot guarantee that they will not break in the future) that describe how to create a control array are http://www.siddharthrout.com/index.php/2018/01/15/vba-control-arrays/ or https://bettersolutions.com/excel/macros/vba-control-arrays.htm - Just search "VBA Control Array" in your favourite search engine.

HideMasterGuessArray and UnhideMasterGuessArray could be collapsed into a single sub:

Sub RevealMasterGuessArray(MasterGuessArrayVisible As Boolean)

I am not sure why ButtonColour and ButtonCaption codes are not aligned - one set of Select gives the corresponding assignment, the other gives a black/white assignment with no comment on how this apparently arbitrary assignment has been created.

Why use Excel?

As a final note: The only Excel function I could see in your code was RandomNumber = Application.WorksheetFunction.RandBetween(0, 5), which could be replaced with VBA's Rnd() function (see: https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/rnd-function).

As such, Excel is not essential to your game, it is just a convenient coding platform. If possible, I would recommend you move to Visual Studio (even the free Community version) which will allow you to use VB.NET.

VB.Net is a different language than VBA, but is also similar in so many ways, so your current logic doesn't require much work to change over. Some of the advantages:

• Better handling of custom controls and assigning handlers to arrays of controls meaning less repetition and better scalability.
• The ability to create a stand-alone program
• Better functionality and handling of Types, but I still prefer Classes!
• Better range of Collection-like classes that give more flexibility on creating a collection of general items (like Moves or controls that present Moves).
• Better alignment with Object-Oriented-Programming, so inheritance and implementation are more flexible.
• You will still practice the same coding principles, so your current learning path will continue with greater flexibility.

There are times when using Excel (or Word or MS-Access) are great foundations for creating programs. I think, in this case, you have out-grown Excel. I originally did a MasterMind-type program (analysis, not a Game) in Visual Studio so I could learn about saving information in XML files!

• learnAsWeGo: Realized that determining matches can be done with use of pointers and copymemory - whole reason I did this procedurally was to get a c++ like experience. Time to really do the heavy lifting !
• learnAsWeGo: Fixed up determine matches function and swapped application.worksheetfunction.rndbetween for RND (see additions to OP) Next up - creating the array of controls. Thanks again.