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

[Paul_Hossler]

Try something like this

Two pieces of code added, one to the WS and one to the ResetTelling sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If IsError(Application.Match(Target.Address(False, False), route, 0)) Then GoTo NiceExit ' not a route cell
If Len(sOldCell) = 0 Then GoTo NiceExit ' just starting
If Len(Range(sOldCell)) > 0 Then GoTo NiceExit ' there was something there

' MsgBox "Left it blank"
Application.EnableEvents = False
Range(sOldCell).Select
Application.EnableEvents = True

NiceExit:
sOldCell = ActiveCell.Address
End Sub







Option Explicit


Public sOldCell As String


Sub ResetTelling()


sOldCell = vbNullString

[vanhunk]

Thank you Paul, it works well on the vertical sections, but gets confused on the horizontal sections and leaves the route.

[Paul_Hossler]

If I leave B16 blank, and click on C16, the selection returns to B16

How are you moving the selection?

[vanhunk]

The selection is moved by entering the character, i.e., enter follows the route. I would type \ when the cursor is in B16, and when I press enter, it will move to C16, and on to D16... If I, for example if the cursor is in D16, enter without first typing &, the cursor will leave the route and go down to D17.

[Aussiebear]

Does this give you any guidance?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Define the range of cells that must be filled sequentially
Const REQUIRED_RANGE_ADDRESS As String = 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")
Dim rngRequired As Range
Dim currentCell As Range
Dim previousCell As Range
Dim i As Long
Dim blnFoundPrevious As Boolean
Dim blnValidMove As Boolean
' Turn off events to prevent re-triggering this macro
Application.EnableEvents = False
On Error GoTo CleanUp
Set rngRequired = Me.Range(REQUIRED_RANGE_ADDRESS)
' Check if the selected cell is within our required range
If Not Intersect(Target, rngRequired) Is Nothing And Target.Cells.Count = 1 Then
Set currentCell = Target
blnValidMove = True ' Assume the move is valid for now
' Find the position of the currentCell within the required range
Dim currentCellIndex As Long
For i = 1 To rngRequired.Cells.Count
If currentCell.Address = rngRequired.Cells(i).Address Then
currentCellIndex = i
Exit For
End If
Next i
' If this is not the first cell in the sequence, check the previous cell
If currentCellIndex > 1 Then
Set previousCell = rngRequired.Cells(currentCellIndex - 1)
' Check if the previous cell is blank
If IsEmpty(previousCell.Value) Or Trim(previousCell.Value) = "" Then
MsgBox "Please fill in cell " & previousCell.Address(False, False) & " before moving to " & currentCell.Address(False, False) & ".", vbExclamation, "Mandatory Field"
previousCell.Activate ' Go back to the previous, unfilled cell
blnValidMove = False
End If
End If
' If the move was valid, and the current cell is in the sequence, we might want to ensure that the user doesn't jump *ahead*
If blnValidMove Then
For i = 1 To currentCellIndex - 1 ' Check all preceding cells
If IsEmpty(rngRequired.Cells(i).Value) Or Trim(rngRequired.Cells(i).Value) = "" Then
MsgBox "Please fill in all preceding mandatory cells first. Cell " & rngRequired.Cells(i).Address(False, False) & " is blank.", vbExclamation, "Mandatory Field"
rngRequired.Cells(i).Activate ' Move to the first blank preceding cell
blnValidMove = False
Exit For
End If
Next i
End If
ElseIf Not Intersect(Target, rngRequired) Is Nothing And Target.Cells.Count > 1 Then
' User selected multiple cells within the required range - prevent this
MsgBox "Please fill cells one by one. Multi-selection in the required range is not allowed.", vbExclamation, "Invalid Selection"
' Find the last filled cell or the first empty cell in the sequence to return to
Dim lastFilledOrFirstEmpty As Range
Set lastFilledOrFirstEmpty = rngRequired.Cells(1) ' Default to the first cell
For i = 1 To rngRequired.Cells.Count
If IsEmpty(rngRequired.Cells(i).Value) Or Trim(rngRequired.Cells(i).Value) = "" Then
Set lastFilledOrFirstEmpty = rngRequired.Cells(i)
Exit For
ElseIf i = rngRequired.Cells.Count Then ' All filled
Set lastFilledOrFirstEmpty = rngRequired.Cells(rngRequired.Cells.Count)
End If
Next i
lastFilledOrFirstEmpty.Activate
Else ' User selected a cell outside the required range
' This is a more complex scenario. Do we allow them to move away if the *last* required cell is blank?
' For simplicity, let's assume they can move away *if* the last required cell is filled, or if the first required cell is not yet started.
' If the first required cell is blank, and they try to go elsewhere, guide them back.
If Not IsEmpty(rngRequired.Cells(1).Value) Or Trim(rngRequired.Cells(1).Value) <> "" Then
' Check if all cells in the required range are filled
Dim allFilled As Boolean
allFilled = True
For i = 1 To rngRequired.Cells.Count
If IsEmpty(rngRequired.Cells(i).Value) Or Trim(rngRequired.Cells(i).Value) = "" Then
allFilled = False
Exit For
End If
Next i
If Not allFilled Then
MsgBox "Please complete all mandatory fields before moving away.", vbExclamation, "Mandatory Fields Pending"
' Activate the first empty cell in the sequence
For i = 1 To rngRequired.Cells.Count
If IsEmpty(rngRequired.Cells(i).Value) Or Trim(rngRequired.Cells(i).Value) = "" Then
rngRequired.Cells(i).Activate
Exit For
End If
Next i
End If
End If
End If
CleanUp:
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End If
End Sub

[vanhunk]

Thank you AB, I get an error message of "Compile error: Constant expression required" in the line:


Const REQUIRED_RANGE_ADDRESS As String = 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")


I am not sure what exactly it is looking for.

[Paul_Hossler]

The selection is moved by entering the character, i.e., enter follows the route. I would type \ when the cursor is in B16, and when I press enter, it will move to C16, and on to D16... If I, for example if the cursor is in D16, enter without first typing &, the cursor will leave the route and go down to D17.

I just patched in some code into your's without really trying to follow most of the logic

To me and INMO it seems a little overly complicatd

I just used Application.OnKey to move around and check the contents, with worksheet.Protect to keep off of the cells that were not on the yellow brick road

Did not follow the way you were scoring



Option Explicit

Public aryRoute As Variant, aryExpectedChars As Variant
Public aryRanges() As Range
Public idxCurrent As Long
Public isInitialized As Boolean


Sub StartWorking()
Sheets("Invul Diagram").Protect UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.OnKey "~", "EnterPressed"
Application.OnKey "{ENTER}", "EnterPressed"


Application.OnKey "{UP}", "ArrowPressed"
Application.OnKey "{LEFT}", "ArrowPressed"
Application.OnKey "{DOWN}", "ArrowPressed"
Application.OnKey "{RIGHT}", "ArrowPressed"

End Sub


Sub StopWorking()
Sheets("Invul Diagram").Unprotect

Application.OnKey "~"
Application.OnKey "{ENTER}"


Application.OnKey "{UP}"
Application.OnKey "{LEFT}"
Application.OnKey "{DOWN}"
Application.OnKey "{RIGHT}"
End Sub


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
Range("InputSelleA").ClearContents
Range("InputSelleB").ClearContents


InitializeRoute
End Sub


Sub InitializeRoute()
Dim i As Long

'index base = 0
aryRoute = 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")

'index base = 0
aryExpectedChars = 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 aryRoute and aryExpectedChars have same length
If UBound(aryRoute) <> UBound(aryExpectedChars) Then
MsgBox "Error: aryRoute and expected characters arrays don't match in length!", vbCritical
Exit Sub
End If

ReDim aryRanges(LBound(aryRoute) To UBound(aryRoute))
For i = LBound(aryRoute) To UBound(aryRoute)
Set aryRanges(i) = Worksheets("Invul Diagram").Range(aryRoute(i))
Next i

idxCurrent = 0

' Select the starting cell
aryRanges(idxCurrent).Select


isInitialized = True

StartWorking
End Sub




Sub EnterPressed()

If Len(aryRanges(idxCurrent)) = 0 Then
aryRanges(idxCurrent).Select
MsgBox "Can't leave it blank"
Exit Sub
End If

If CStr(aryRanges(idxCurrent).value) <> aryExpectedChars(idxCurrent) Then
aryRanges(idxCurrent).ClearContents
aryRanges(idxCurrent).Select
MsgBox "Character doesn't match"
Range("Score").value = Range("Score").value - 1
Exit Sub
End If

Range("Score").value = Range("Score").value + 2
idxCurrent = idxCurrent + 1


If idxCurrent < UBound(aryRanges) Then
aryRanges(idxCurrent).Select
Else
MsgBox "All done"
End If


End Sub


Sub ArrowPressed()
aryRanges(idxCurrent).Select
MsgBox "Can't use arrow keys, use Enter"
End Sub

[vanhunk]

Thank you Paul, it works perfectly. I have not really used Application.Onkey before. I was somehow of the opinion that it is unstable.

Kind Regards
vanhunk

[Paul_Hossler]

I've found .OnKey to be reliable, but .SendKeys can be flakey

[vanhunk]

I've found .OnKey to be reliable, but .SendKeys can be flakey

Thank you for that, I will keep that in mind.

Regards
vanhunk

[Aussiebear]

Sorry but that was my mistake. Apparently you can't use Const with an array function.

As an alternative to Paul's code does this work?



Private requiredCellAddressesArray As Variant ' Declare at the top of the module, not inside the sub

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.
' This ensures the array is set up when the user first enters the sheet.
If IsEmpty(requiredCellAddressesArray) Then
' Only initialize if not already done
Call InitializeRequiredCellsArray
End If
' Optional: Ensure the first cell is activated when the sheet is activated
If Not IsEmpty(requiredCellAddressesArray) Then
Me.Range(requiredCellAddressesArray(LBound(requiredCellAddressesArray))).Ac tivate
End If
End Sub

Private Sub InitializeRequiredCellsArray()
' Define your non-contiguous cells here.
' This needs to be a regular variable, populated at runtime.
requiredCellAddresses Array = 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)
' This event fires when the sheet becomes active.
' It's a good place to initialize our array of cell addresses once.
' This ensures the array is set up when the user first enters the sheet.
If IsEmpty(requiredCellAddressesArray) Then
' Only initialize if not already done
Call InitializeRequiredCellsArray
End If
Dim currentCellAddress As String
Dim previousCellAddress As String
Dim currentCellIndex As Long
Dim i As Long
Dim blnIsValidMove As Boolean
' Turn off events to prevent re-triggering this macro during our own actions
Application.EnableEvents = False
On Error GoTo CleanUp
' Check if the selected cell is one of our required cells
blnIsValidMove = False
currentCellIndex = -1
' Initialize to not found
For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
If Target.Address(False, False) = requiredCellAddressesArray(i) Then
currentCellIndex = i
blnIsValidMove = True
Exit For
End If
Next i
' If the selected cell is not one of our designated cells, or it's a multi-selection
If Not blnIsValidMove Or Target.Cells.Count > 1 Then
Dim firstEmptyRequiredCellIndex As Long
firstEmptyRequiredCellIndex = -1
' Find the first empty cell in the sequence
For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
Set currentCell = Me.Range(requiredCellAddressesArray(i))
If IsEmpty(currentCell.Value) Or Trim(currentCell.Value) = "" Then
firstEmptyRequiredCellIndex = i
Exit For
End If
Next i
' If there's an empty required cell, activate it
If firstEmptyRequiredCellIndex <> -1 Then
MsgBox "Please fill in all preceding mandatory fields. Cell " & requiredCellAddressesArray(firstEmptyRequiredCellIndex) & " is blank.", vbExclamation, "Mandatory Field"
Me.Range(requiredCellAddressesArray(firstEmptyRequiredCellIndex)).Activate
Else
' All required cells are filled, allow movement freely
' No action needed, user can move elsewhere
End If
Else
' User selected a designated single cell in the sequence
' Check if the immediately preceding cell in the sequence is filled
If currentCellIndex > LBound(requiredCellAddressesArray) Then
Set previousCell = Me.Range(requiredCellAddressesArray(currentCellIndex - 1))
If IsEmpty(previousCell.Value) Or Trim(previousCell.Value) = "" Then
MsgBox "Please fill in cell " & previousCell.Address(False, False) & " before moving to " & Target.Address(False, False) & ".", vbExclamation, "Mandatory Field"
previousCell.Activate
' Go back to the previous, unfilled cell
End If
End If
' Additionally, ensure no cells earlier in the sequence were skipped
For i = LBound(requiredCellAddressesArray) To currentCellIndex - 1
Set currentCell = Me.Range(requiredCellAddressesArray(i))
' Use currentCell for iteration now
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

[vanhunk]

Hi AB, it is complaining about the syntax of the following section:


Private Sub InitializeRequiredCellsArray()
' Define your non-contiguous cells here.
' This needs to be a regular variable, populated at runtime. requiredCellAddresses
Array = 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

[Aussiebear]

Okay...... yet another swing and a miss. I'm heading back to the dugout.


Hang on a minute, I see the issue. Try the amended code in post# 12

[vanhunk]

Hi Aussiebear

It is still complaining about a syntax error in:


Private Sub InitializeRequiredCellsArray()
' Define your non-contiguous cells here.
' This needs to be a regular variable, populated at runtime.
requiredCellAddresses Array = 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


It is also complaining about a couple of variables that are not defined.

Regards
vanhunk

[Aussiebear]

Sorry mate but that's three air swings for me so I'm out.

[Paul_Hossler]

Sorry mate but that's three air swings for me so I'm out.





requiredCellAddresses Array = Array( "B4", ......




Space between 'requiredCellAddresses' and 'Array = '

[Aussiebear]

:jail:..... you'd think I'd know about space given my background.

[vanhunk]

Hi Aussiebear
Thank you for your efforts, I appreciate it and I believe the Excel community does as well.

The project now catches the blank cells, but not incorrect entries.
I also does not follow the route around the corners.

The syntax corrected code for the InitializeRequiredCellsArray, as you pointed out is:


Private Sub InitializeRequiredCellsArray()
' Define your non-contiguous cells here.
' This needs to be a regular variable, populated at runtime.
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



Regards
vanhunk

[Aussiebear]

Surely you can add you correct characters into the code?

[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))).Ac tivate
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))).Ac tivate
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

[vanhunk]

@Aussiebear: Thank you so much for all your effort.

Your code came very close to achieve the required result. It is sort of working.

Let me explain:
Going down, the code works as expected.
Going right or left, the cursor leaves the path (route), complains unnecessarily and jumps to the next block (cell) in the path.
Going up, it takes a detour, all the way down, until it leaves the path, complains unnecessarily, and then jumps to the next block in the both.


Without the detours, and complaining where it shouldn't, it does follow the path and does catch blanks and incorrect inputs.

Kind Regards
vanhunk

[vanhunk]

I have added the latest version by Aussiebear

[Aussiebear]

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
' Find the first empty or incorrect cell to activate initially
Dim firstProblematicCellToActivate As Range
Dim idx As Long
For idx = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
Set firstProblematicCellToActivate = Me.Range(requiredCellAddressesArray(idx))
If IsEmpty(firstProblematicCellToActivate.Value) Or Trim(firstProblematicCellToActivate.Value) = "" Or _
CStr(firstProblematicCellToActivate.Value) <> expectedCharsArray(idx) Then
firstProblematicCellToActivate.Activate
Exit For
ElseIf
idx = UBound(requiredCellAddressesArray) Then
' If all are filled, activate the last one Me.Range(requiredCellAddressesArray(UBound(requiredCellAddressesArray))).Ac tivate
End If
Next idx
End If
End Sub

Private Sub InitializeRequiredCellsArray()
' 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"
isInitialized = False
' Prevent further execution if there's a mismatch
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
Dim targetIsPreviousCellInSequence As Boolean
' New flag for specific case
' 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 cases based on where the user clicked
' Case 1: User clicked on a single cell within the designated path.
If blnTargetIsInRequiredPath And Target.Cells.Count = 1 Then
' Check if the immediately preceding cell IN THE SEQUENCE is filled and correct
' This is the "snake game" logic.
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
GoTo CleanUp
' Exit the sub after activating the correct cell
End If
End If
' Additionally, ensure no cells earlier in the sequence were skipped AND are correct
' This catches cases where they fill the immediate previous, but skipped one even earlier.
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
GoTo CleanUp
' Exit the sub after activating the correct cell
End If
Next i
' Case 2: User clicked outside the designated path, or selected multiple cells.
Else
' Not blnTargetIsInRequiredPath Or Target.Cells.Count > 1
Dim firstProblematicCellToActivate As Range
Dim firstProblematicCellIndex As Long
firstProblematicCellIndex = -1
' Initialize to not found
' Find the first empty or incorrect cell in the ENTIRE defined sequence
For i = LBound(requiredCellAddressesArray) To UBound(requiredCellAddressesArray)
Set firstProblematicCellToActivate = Me.Range(requiredCellAddressesArray(i))
If IsEmpty(firstProblematicCellToActivate.Value) Or Trim(firstProblematicCellToActivate.Value) = "" Or CStr(firstProblematicCellToActivate.Value) <> expectedCharsArray(i) Then
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 complete all mandatory fields correctly before moving away or selecting multiple cells. Cell " & firstProblematicCellToActivate.Address(False, False) & _
" is either blank or contains an incorrect character. " & "Expected: '" & expectedCharsArray(firstProblematicCellIndex) & "'", vbExclamation, _
"Mandatory Field / Invalid Selection"
firstProblematicCellToActivate.Activate
GoTo CleanUp
' Exit the sub after activating the correct cell
Else
' All required cells are filled and correct. User is allowed to move freely.
' No action needed, user can move elsewhere.
End If
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

[vanhunk]

Hi Aussiebear, thank you for sticking it out, unfortunately the behaviour has not changed from the previous post.
Regards
vanhunk

[Aussiebear]

Okay.... I going to have to admit defeat.