For Each loop only fires once

user_13965311 0
Viewed 102

I am making a connect four game to learn some VBA.

I have an unbound form with buttons for the game pieces (tokens). An option group to pick which column to drop the token. A textbox (hidden) that represents which row the token is to be dropped on.

If I manually input a number in the textbox then hit the Drop Button it works as intended. Fills in the token and adds one to the correct textbox.

Example:
Put a 1 in to txtR1 hit drop button.
Token is filled in and txtR1 now shows 2, hit the drop button again and nothing. If I manually put a 2 in txtR1 then it works as intended.

Is the txtbox not updated when it shows it is?

I arranged the code str and row in the if statement and tried adding save in there and refresh.

Private Sub drop()
    
    Dim Token As Control
    Dim Row As Control
    Dim r As Integer
    Dim c As Integer
    Dim str As String
    
    c = Me.frmCol
    str = "txtR" & c
    Set Row = Me(str)
    r = Row
    
    For Each Token In Controls
    
        If InStr(Token.Tag, "C" & c) Then
    
            If Right(Token.name, 1) = Row Then
            
                Token.BackStyle = 1
                Token.BackColor = vbBlue
                Row = r + 1
                Exit Sub
                
            End If
    
        End If
        
    Next Token
    
End Sub

enter image description here

ms-access vba
2 Answers

Consider alternative that uses numeric suffix control naming without looping to set token colors but uses loop to reset the game:

Private Sub optDrop_Click()
Dim r As Integer
Dim c As Integer
c = Me.optDrop
r = Me("tbx" & c) + 1
If Me("tbx" & c) = 6 Then
    MsgBox "This column is full. Pick another."
Else
    Me("box" & c & r).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
    Me("tbx" & c) = Me("tbx" & c) + 1
    Me.tbxPlayer = IIf(Me.tbxPlayer = "Player 1", "Player 2", "Player 1")
    Me.tbxPlayer.BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
End If
Me.optDrop = 0
End Sub

Private Sub btnReset_Click()
Dim c As Integer, r As Integer
Me.tbxPlayer = "Player 1"
Me.tbxPlayer.BackColor = vbCyan
For c = 1 To 7
    For r = 1 To 6
        Me("box" & c & r).BackColor = vbWhite
    Next
    Me("tbx" & c) = 0
Next
End Sub

Rectangle controls are used for tokens and optDrop is option group frame control.

Haven't figured out code to check for 4 in a row and declare winner. Probably beyond my ability and interest.

BONUS: If you want to watch the tokens 'dropping', consider:

Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

Private Sub optDrop_Click()
Dim r As Integer, c As Integer, x As Integer, dteD As Date
c = Me.optDrop
r = Me("tbx" & c) + 1
If Me("tbx" & c) = 6 Then
    MsgBox "This column is full. Pick another."
Else
    For x = 6 To r Step -1
        Me("box" & c & x).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
        dteD = Now()
        Do
            Sleep 300
            DoEvents
        Loop Until Now >= dteD
        Me("box" & c & x).BackColor = vbWhite
    Next
    Me("box" & c & r).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
    Me("tbx" & c) = Me("tbx" & c) + 1
    Me.tbxPlayer = IIf(Me.tbxPlayer = "Player 1", "Player 2", "Player 1")
    Me.tbxPlayer.BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
End If
Me.optDrop = 0
End Sub

I moved toggle buttons to top of columns so get more of a feel of 'dropping' tokens.

user_76071900

Found my mistake. Second If statement was wrong here is the corrected code if anyone ever needs it. Want to again say thank you for the people that was helping me.

Private Sub drop()

Dim Token As Control
Dim Row As Control
Dim r As Integer
Dim c As Integer
Dim str As String

c = Me.frmCol
str = "txtR" & c
Set Row = Me(str)
r = Row

For Each Token In Controls

    If InStr(Token.Tag, "C" & c) Then

        If Right(Token.name, 1) = r Then
        
            Token.BackStyle = 1
            Token.BackColor = vbBlue
            Row = r + 1
            Exit Sub
            
        End If

    End If
    
Next Token

End Sub
user_139653110
Related