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

Try something like this

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

Code:

---

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

---

Code:

---

Option Explicit


Public sOldCell As String


Sub ResetTelling()


    sOldCell = vbNullString

---

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

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

How are you moving the selection?

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.

Does this give you any guidance?

Code:

---

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

---

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

Code:

---

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.

Quote:

---

Originally Posted by 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.

---

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

Code:

---

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

---

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

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

Quote:

---

Originally Posted by Paul_Hossler

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

---

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

Regards
vanhunk

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?

Code:

---

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

---

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

Code:

---

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

---

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

Hi Aussiebear

It is still complaining about a syntax error in:

Code:

---

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

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

Quote:

---

Originally Posted by Aussiebear

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

---

Code:

---


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



---

Space between 'requiredCellAddresses' and 'Array = '

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

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:

Code:

---

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

Surely you can add you correct characters into the code?

Code:

---

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

---

aarrrggh!!! Final effort for me with this code

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

---