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))).Activate
    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]

..... 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?