1 Attachment(s)
Prevent enter to move to the next cell if no character is typed
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:
Code:
' 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):
Code:
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
