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

[vanhunk]

PREVENT ENTER TO MOVE TO THE NEXT CELL IF NO CHARACTER IS TYPED

I have a snake like range (route), i.e., it goes down, to the left, up, and to the right, as can be seen in the attached Workbook.

Cell entries follow the range in sequence (the range is captured in an Array). If the incorrect character is entered, the code prevents entry into the next cell. The correct characters are captured in another Array.

This is working fine, however, when no character is typed, on Enter, the next cell is selected, it also does not follow the route anymore.

What I could not achieve, and where I would appreciate your help, is to prevent the next cell from being selected, and leaving of the route, if no character is typed on enter, i.e., the cell is empty.

I have tried a number of different approaches and could not get it to work.

The following code is in the sheet (Invul Diagram) module:

' Declare at the top of the sheet module
Private route As Variant
Private expectedChars As Variant
Private currentIndex As Integer
Private isInitialized As Boolean

Private Sub CommandButton1_Click()
    ResetTelling
End Sub

Private Sub Worksheet_Activate()
    InitializeRoute
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    ' Ignore multi-cell changes
    If Target.Cells.Count > 1 Then Exit Sub
    
    ' Initialize if needed
    If Not isInitialized Then InitializeRoute
    
    ' Check if we're in a route cell
    Dim cellPos As Variant
    cellPos = Application.Match(Target.Address(False, False), route, 0)
    If IsError(cellPos) Then Exit Sub
    
    Application.EnableEvents = False
    
    ' Store current position
    Dim currentCharIndex As Long
    currentCharIndex = cellPos - 1 ' 0-based index
    
    ' First check for empty/blank entry  'THIS DOES NOT WORK!
    If IsEmpty(Target) Or Trim(Target.value) = "" Then
        Application.Undo ' Revert the empty entry
        MsgBox "Please enter a character", vbExclamation
        Range(route(currentCharIndex)).Select
        Application.EnableEvents = True
        Exit Sub
    End If
    
    ' Now check the entered value
    Dim enteredValue As String
    Dim expectedValue As String
    enteredValue = CStr(Target.value)
    expectedValue = CStr(expectedChars(currentCharIndex))
    
    If enteredValue = expectedValue Then
        ' Correct character - move to next cell
        Range("Score").value = Range("Score").value + 2
        If currentCharIndex < UBound(route) Then
            Range(route(currentCharIndex + 1)).Select
        Else
            MsgBox "Congratulations! You completed the sequence!", vbInformation
        End If
    Else
        ' Incorrect character
        Application.Undo ' Revert the incorrect entry
        MsgBox "Incorrect! Expected: " & expectedChars(currentCharIndex), vbExclamation
        Range("Score").value = Range("Score").value - 1
        Range(route(currentCharIndex)).Select
    End If
    
    Application.EnableEvents = True
End Sub

  
Private Sub InitializeRoute()
    route = 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")
    
    expectedChars = 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 route and expectedChars have same length
    If UBound(route) <> UBound(expectedChars) Then
        MsgBox "Error: Route and expected characters arrays don't match in length!", vbCritical
        Exit Sub
    End If
    
    currentIndex = 0
    isInitialized = True
    
    ' Select the starting cell
    Range(route(currentIndex)).Select
End Sub

The following code is in a normal module (Module1):

Option Explicit

Sub ResetTelling()
    If Range("Score").value > Range("HighScore").value Then
        Range("HighScore").value = Range("Score").value
    End If

    Range("Score").value = 0

    ' Clear specified ranges
    Union(Range("InputSelleA"), Range("InputSelleB")).ClearContents

    ' Select starting cell
    ActiveSheet.Range("BEGIN").Offset(1, 0).Select
End Sub

Many thanks in advance.
vanhunk