Message Box Range

The problem is when you "tab" the next available cell will be selected.
When you "Enter", the selection will be the next available cell down.

When you hit enter, L10 becomes the target cell. Selecting AI5 is too late,
the code still has to process L10 in the selection_change events.

One idea I have would be to check if the previous target address was J4 and
the current target address is L10, if they equal, then select AI5 and exit the selection_change event.
.
.
Get targetaddress.jpg

Check it the target ranges match
.
TargetAddress.jpg

.

Dim x As String
Private Sub Worksheet_Change(ByVal Target As Range)
'Target.Select
    If Not Intersect(Target, Range("J4")) Is Nothing Then
        MsgBox "Stacy, Dont Forget to Click the Check Box", vbOKOnly, "REMINDER"
        x = Target.Address
    ElseIf Not Intersect(Target, Range("AI5")) Is Nothing Then
        Range("R38").Activate
    ElseIf Not Intersect(Target, Range("R38")) Is Nothing Then
        Range("U41").Activate
    ElseIf Not Intersect(Target, Range("U41")) Is Nothing Then
        Range("Q44").Activate
    ElseIf Not Intersect(Target, Range("Q44")) Is Nothing Then
        Range("J4").Activate
    End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 
    If Target.Address = "$L$10" And x = "$J$4" Then
        Range("AI5").Select
        x = ""
        Exit Sub
    End If


    'If Target.Count > 1 Then Exit Sub
    Dim iColor As Long
    '--------  highlight selected cell
    With Target
        'iColor = .Interior.ColorIndex
        If iColor < 0 Then
            iColor = 6
        Else
            iColor = iColor + 6
        End If
        Cells.FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
        .FormatConditions(1).Interior.ColorIndex = iColor
    End With
    '---------
    'create 'toggle' status for cells L16 & O16 & F27 & L27 - set **check mark** in cell.
    If Not Intersect(Target, Range("L10,L12,L16,L18,L22,L24,L28,L30,L34,L36")) Is Nothing Then
        With Target
            'Application.ScreenUpdating = False
            .Font.Name = "Wingdings 1"
            .Font.Bold = True
            .Font.ColorIndex = 3
            If .Value = "" Then
                .Value = ChrW(10004)                   'displays a check mark.
                .Offset(, 2).Select
            Else
                .Value = ""
                .Offset(, 2).Select
            End If
        End With    'target
        Application.ScreenUpdating = True
        Exit Sub
    End If


    '-------------------
    '"r" in that Font displays an "X"
    If Not Intersect(Target, Range("C8,C14,C20,C26,C32,C38,C41,C44")) Is Nothing Then
        'Application.ScreenUpdating = False
        With Target
            .Font.Name = "Wingdings 1"
            .Font.Bold = True
            .Font.Color = vbRed
            If .Value = "" Then
                .Value = ChrW(10008)
                .Offset(0, 2).Select
            Else
                .Value = ""
                .Offset(0, 2).Select
            End If
        End With    'target
        Application.ScreenUpdating = True
        Exit Sub
    End If
End Sub