Prevent enter to move to the next cell if no character is typed

[Aussiebear]

Private requiredCellAddressesArray As Variant 
' Declare at the top of the module

Private Sub Worksheet_Activate()
    ' This event fires when the sheet becomes active.
    ' It's a good place to initialize our array of cell addresses once.
    If IsEmpty(requiredCellAddressesArray) Then 
        ' Only initialize if not already done
        Call InitializeRequiredCellsArray
    End If
    ' Optional: Ensure the first cell in the sequence is activated when the sheet is activated
    If Not IsEmpty(requiredCellAddressesArray) Then
        Me.Range(requiredCellAddressesArray(LBound(requiredCellAddressesArray))).Activate
    End If
End Sub

Private Sub InitializeRequiredCellsArray()
    ' Define your non-contiguous cells in the exact "snake game" order.
    ' Ensure the order is precise as this defines the user's path.
    requiredCellAddressesArray = Array("B4", "B5", "B6", "B7", "B8", "B9", "B10", "B11", "B12", "B13", "B14", "B15", "B16", "C16", "D16", _
    "E16", "F16", "G16", "G15", "G14", "G13", "G12", "G11", "F11", "E11", "E10", "E9", "E8", "F8", "G8", "H8", "I8", "J8", "J9", "J10", "J11", _
    "J12", "J13", "K13", "L13", "M13", "N13", "N12", "N11", "N10", "O10", "P10", "Q10", "Q9", "Q8", "R8", "S8", "S7", "S6", "S5", "R5", "Q5", _
    "P5", "O5", "N5", "M5", "M4", "L4", "K4", "J4", "I4", "I5", "H5", "G5", "F5", "F4", "F3", "G3", "G2", "H2", "I2", "J2", "K2", "L2", "M2", "N2", _
    "O2", "P2", "Q2", "R2", "R3", "S3", "T3", "U3", "V3", "V4", "V5", "V6", "V7", "V8", "V9", "W9", "X9", "X8", "X7", "Y7", "Y6", "Y5", "Y4", "X4", _
    "X3", "X2", "Y2", "Z2", "AA2", "AA3", "AA4", "AA5", "AA6", "AA7", "AA8", "AA9", "AA10", "Z10", "Z11", "Z12", "Z13", "Z14", "Z15", "Y15", "X15", _
    "W15", "V15", "U15", "U16", "T16", "S16", "R16", "Q16", "P16", "O16", "N16", "M16")
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim currentCellAddress As String
    Dim previousCellAddressInSequence As String 
    ' Renamed for clarity
    Dim currentCellIndexInArray As Long 
    ' Renamed for clarity
    Dim i As Long
    Dim blnTargetIsInRequiredPath As Boolean
    Dim rngPreviousCell As Range 
    ' To hold the actual Range object of the previous cell
    ' Turn off events to prevent re-triggering this macro during our own actions
    Application.EnableEvents = False
    On Error GoTo CleanUp
    If IsEmpty(requiredCellAddressesArray) Then 
        ' Ensure array is initialized
        Call InitializeRequiredCellsArray
    End If
    ' 1. Determine if the selected cell (Target) is part of our required path
    blnTargetIsInRequiredPath = False
    currentCellIndexInArray = -1 
    ' Initialize to not found
    For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
        ' Compare the full address to ensure exact match (e.g., $A$1 vs $A$1)
        If Target.Address = Me.Range(requiredCellAddressesArray(i)).Address Then
            currentCellIndexInArray = i
            blnTargetIsInRequiredPath = True
            Exit For
        End If
    Next i
    ' 2. Handle invalid selections (multi-cell or outside the path) 
    If Not blnTargetIsInRequiredPath Or Target.Cells.Count > 1 Then
        Dim firstEmptyRequiredCell As Range 
        ' Holds the Range object of the first empty cell
        firstEmptyRequiredCellIndex = -1
        ' Find the first empty cell in the defined sequence
        For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
            Set firstEmptyRequiredCell = Me.Range(requiredCellAddressesArray(i))
            If IsEmpty(firstEmptyRequiredCell.Value) Or Trim(firstEmptyRequiredCell.Value) = "" Then
                firstEmptyRequiredCellIndex = i
                Exit For
            End If
        Next i
        ' If there's an empty required cell, activate it and warn the user
        If firstEmptyRequiredCellIndex <> -1 Then
            MsgBox "Please fill in all preceding mandatory fields. Cell " & firstEmptyRequiredCell.Address(False, False) & " is blank.", vbExclamation, "Mandatory Field"
            firstEmptyRequiredCell.Activate
        Else
            ' All required cells are filled, allow movement freely outside the path.
            ' No action needed, user can move elsewhere.
        End If
        ' 3. Handle valid single cell selection within the required path 
    Else 
        ' User selected a designated single cell in the sequence
        ' Check if the immediately preceding cell IN THE SEQUENCE is filled
        If currentCellIndexInArray > LBound(requiredCellAddressesArray) Then
            ' Get the address of the actual previous cell in the defined sequence
            previousCellAddressInSequence = requiredCellAddressesArray(currentCellIndexInArray - 1)
            Set rngPreviousCell = Me.Range(previousCellAddressInSequence)
            ' Check if that specific previous cell is empty
            If IsEmpty(rngPreviousCell.Value) Or Trim(rngPreviousCell.Value) = "" Then
                MsgBox "Please fill in cell " & rngPreviousCell.Address(False, False) & " before moving to " & Target.Address(False, False) & ".", vbExclamation, "Mandatory Field"
                rngPreviousCell.Activate 
                ' Force user back to the unfilled previous cell
            End If
        End If
        ' Additionally, ensure no cells earlier in the sequence were skipped
        ' This catches cases where they fill the immediate previous, but skipped one even earlier.
        For i = LBound(requiredCellAddressesArray) To currentCellIndexInArray - 1
            Set currentCell = Me.Range(requiredCellAddressesArray(i)) 
            ' Using currentCell to iterate through preceding
            If IsEmpty(currentCell.Value) Or Trim(currentCell.Value) = "" Then
                MsgBox "Please fill in all preceding mandatory fields. Cell " & currentCell.Address(False, False) & " is blank.", vbExclamation, "Mandatory Field"
                currentCell.Activate 
                ' Go back to the first skipped cell
                Exit For 
                ' Stop checking once the first skipped cell is found
            End If
        Next i
    End If
    CleanUp:    
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
    End If
End Sub

[Aussiebear]

aarrrggh!!! Final effort for me with this code

Private requiredCellAddressesArray As Variant 
' Stores the sequence of cell addresses
Private expectedCharsArray As Variant 
      ' Stores the expected character for each cell in the sequence
' Flag to ensure initialization only happens once
Private isInitialized As Boolean

Private Sub Worksheet_Activate()
    ' This event fires when the sheet becomes active.
    ' It's a good place to initialize our arrays once.
    If Not isInitialized Then
        Call InitializeRequiredCellsArray        isInitialized = True
    End If
    ' Ensure the first cell in the sequence is activated when the sheet is activated
    If Not IsEmpty(requiredCellAddressesArray) Then
        ' Optional: Clear content of all cells in the sequence on activate, if needed
        ' For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
            '     Me.Range(requiredCellAddressesArray(i)).ClearContents
        ' Next i
        Me.Range(requiredCellAddressesArray(LBound(requiredCellAddressesArray))).Activate
    End If
End Sub

Private Sub InitializeRequiredCellsArray() 
    ' Renamed from InitializeRoute for consistency with previous discussion
    ' Define your non-contiguous cells in the exact "snake game" order.
    requiredCellAddressesArray = Array("B4", "B5", "B6", "B7", "B8", "B9", "B10", "B11", "B12", "B13", "B14", "B15", "B16", "C16", "D16", "E16", "F16", "G16", "G15", _
    "G14", "G13", "G12", "G11", "F11", "E11", "E10", "E9", "E8", _        "F8", "G8", "H8", "I8", "J8", "J9", "J10", "J11", "J12", "J13", "K13", "L13", "M13", "N13", "N12", "N11", _
    "N10", "O10", "P10", "Q10", "Q9", "Q8", "R8", "S8", "S7", "S6", "S5", "R5", "Q5", "P5", "O5", "N5", "M5", "M4", "L4", "K4", "J4", "I4", "I5", "H5", "G5", "F5", "F4", "F3", _
    "G3", "G2", "H2", "I2", "J2", "K2", "L2", "M2", "N2", "O2", "P2", "Q2", "R2", "R3", "S3", "T3", "U3", "V3", "V4", "V5", "V6", "V7", "V8", "V9", "W9", "X9", "X8", "X7", "Y7", _
    "Y6", "Y5", "Y4", "X4", "X3", "X2", "Y2", "Z2", "AA2", "AA3", "AA4", "AA5", "AA6", "AA7", "AA8", "AA9", "AA10", "Z10", "Z11", "Z12", "Z13", "Z14", "Z15", "Y15", "X15", _
    "W15", "V15", "U15", "U16", "T16", "S16", "R16", "Q16", "P16", "O16", "N16", "M16")
    ' Define the expected characters for each cell in the exact same order as requiredCellAddressesArray
    expectedCharsArray = Array("8", "C", "r", "f", "e", """", "P", "N", "K", ";", "T", "_", "\", ".", "&", ">", "A", "b", "[", "!", "x", "r", ";", "3", "V", "3", "x", "j", "&", "C", "Z", "n", _
    """", "z", "$", "i", "\", "w", "%", "N", "d", "H", "f", "Z", "H", "x", "E", "M", "V", "#", "V", "F", "3", "B", "q", "B", """", ":", "1", "v", "A", "y", "Q", "c", ":", "G", "c", "g", "K", _
    "<", "{", "8", "g", "8", "g", "G", ":", "c", "Q", "y", "C", "2", "{", "K", "j", "K", "j", "B", "v", ";", "j", "Q", ";", "X", "L", "3", "#", "0", "@", "X", "@", "<", "}", "7", "j", "7", ".", _
    "7", "[", "|", "[", "m", "}", "<", "M", "A", "F", "h", "F", ".", "L", "$", "w", "<", "D", "2", ".", ",", "w", "Q", "1", "a", "k", "i", "n", "a", "D", "%")
    ' Verify both arrays have the same length
    If UBound(requiredCellAddressesArray) <> UBound(expectedCharsArray) Then
        MsgBox "Error: The list of required cells and expected characters do not match in length. Please check the VBA code.", vbCritical, "Initialization Error"
        ' Optionally, reset isInitialized to False or disable events to prevent further errors
        isInitialized = False
        Exit Sub
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim currentCellAddress As String
    Dim previousCellAddressInSequence As String
    Dim currentCellIndexInArray As Long
    Dim i As Long
    Dim blnTargetIsInRequiredPath As Boolean
    Dim rngPreviousCell As Range
    Dim rngCurrentCellInLoop As Range 
    ' For iterating through preceding cells
    ' Turn off events to prevent re-triggering this macro during our own actions
    Application.EnableEvents = False
    On Error GoTo CleanUp
    ' Ensure arrays are initialized (especially if user opens directly to this sheet without activate)
    If Not isInitialized Then
        Call InitializeRequiredCellsArray        isInitialized = True
        If UBound(requiredCellAddressesArray) <> UBound(expectedCharsArray) Then 
            ' Check again in case of error in init
            Application.EnableEvents = True
            Exit Sub '
            Exit if arrays are mismatched
        End If
    End If
    ' 1. Determine if the selected cell (Target) is part of our required path 
    blnTargetIsInRequiredPath = False
    currentCellIndexInArray = -1 
    ' Initialize to not found
    For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
        If Target.Address = Me.Range(requiredCellAddressesArray(i)).Address Then
            currentCellIndexInArray = i
            blnTargetIsInRequiredPath = True
            Exit For
        End If
    Next i
    ' 2. Handle invalid selections (multi-cell or outside the path) 
    If Not blnTargetIsInRequiredPath Or Target.Cells.Count > 1 Then
        Dim firstEmptyOrIncorrectRequiredCell As Range 
        ' Holds the Range object of the first problematic cell
        firstProblematicCellIndex = -1
        ' Find the first empty or incorrect cell in the defined sequence
        For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
            Set firstEmptyOrIncorrectRequiredCell = Me.Range(requiredCellAddressesArray(i))
            ' Check for empty OR incorrect character
            If IsEmpty(firstEmptyOrIncorrectRequiredCell.Value) Or Trim(firstEmptyOrIncorrectRequiredCell.Value) = "" _
                Or CStr(firstEmptyOrIncorrectRequiredCell.Value) <> expectedCharsArray(i) Then 
                ' CStr to ensure type compatibility
                firstProblematicCellIndex = i
                Exit For
            End If
        Next i
        ' If there's a problematic required cell, activate it and warn the user
        If firstProblematicCellIndex <> -1 Then
            MsgBox "Please fill in all preceding mandatory fields correctly. Cell " & firstEmptyOrIncorrectRequiredCell.Address(False, False) & _
            " is either blank or contains an incorrect character." & "Expected: '" & expectedCharsArray(firstProblematicCellIndex) & "'", vbExclamation, "Mandatory Field / Incorrect Character"
            firstEmptyOrIncorrectRequiredCell.Activate
        Else
            ' All required cells are filled and correct, allow movement freely outside the path.
            ' No action needed, user can move elsewhere.
        End If
        ' 3. Handle valid single cell selection within the required path
    Else 
        ' User selected a designated single cell in the sequence
        ' Check if the immediately preceding cell IN THE SEQUENCE is filled and correct
        If currentCellIndexInArray > LBound(requiredCellAddressesArray) Then
            previousCellAddressInSequence = requiredCellAddressesArray(currentCellIndexInArray - 1)
            Set rngPreviousCell = Me.Range(previousCellAddressInSequence)
            ' Check if that specific previous cell is empty OR contains the wrong character
            If IsEmpty(rngPreviousCell.Value) Or Trim(rngPreviousCell.Value) = "" Or CStr(rngPreviousCell.Value) <> expectedCharsArray(currentCellIndexInArray - 1) Then
                MsgBox "Please fill in cell " & rngPreviousCell.Address(False, False) & " correctly before moving to " & Target.Address(False, False) & ". Expected: '" & _
                expectedCharsArray(currentCellIndexInArray - 1) & "'", vbExclamation, "Mandatory Field / Incorrect Character"
                rngPreviousCell.Activate 
                ' Force user back to the unfilled/incorrect previous cell
            End If
        End If
        ' Additionally, ensure no cells earlier in the sequence were skipped AND are correct
        For i = LBound(requiredCellAddressesArray) To currentCellIndexInArray - 1
            Set rngCurrentCellInLoop = Me.Range(requiredCellAddressesArray(i))
            If IsEmpty(rngCurrentCellInLoop.Value) Or Trim(rngCurrentCellInLoop.Value) = "" Or CStr(rngCurrentCellInLoop.Value) <> expectedCharsArray(i) Then
                MsgBox "Please fill in all preceding mandatory fields correctly. Cell " & rngCurrentCellInLoop.Address(False, False) & " is either blank or contains an incorrect character. " & _
                "Expected: '" & expectedCharsArray(i) & "'", vbExclamation, "Mandatory Field / Incorrect Character"
                rngCurrentCellInLoop.Activate 
                ' Go back to the first skipped/incorrect cell
                Exit For 
                ' Stop checking once the first problematic cell is found
            End If
        Next i
    End If
    CleanUp:
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "An error occurred: " & Err.Description & vbCrLf & "Error Number: " & Err.Number, vbCritical, "Error"
    End If
End Sub