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