After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,570
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'm having some problems with how this code is misbehaving (as expected).

Code:
Sub Worksheet_Change(ByVal Target As Range)
    Dim cval As String, aval As String
    Dim bval As String, dval As String
    Dim eval As String
    Dim msg1 As String, msg2 As String, msg3 As String
    Dim acnt As Long
    Dim lrow As Long
    Dim ui1 As Variant
   
'permit number
    If Target.Cells.CountLarge = 1 And Target <> "" And Target.Address = "$A$6" Then
'Stop
        Application.EnableEvents = False
        Dim val As String, i As Long, mbyes
        val = Target.Value
        If WorksheetFunction.CountIf(Columns(1), val) > 1 Then
            i = WorksheetFunction.Match(CLng(val), Range("A7", Cells(Rows.Count, "A").End(xlUp)), 0) + 6
            mbyes = MsgBox("Permit already exists in database at row " & i & Chr(13) & "View exisiting entry?", vbYesNo, "Permit Entry Error")
            If mbyes = vbYes Then
                With Me
                    .Unprotect
                    .Rows(6).EntireRow.Delete
                    Application.Goto Range("A" & i - 1), scroll:=True
                    .Protect
                End With
            End If
        Else
            With ws_pdata.Cells(6, 2)
                ws_pdata.Unprotect
                .Locked = False
                .Select
                ws_pdata.Protect
            End With
        End If
        pnum = "R" & val
        Application.EnableEvents = True
    'If Not Application.Intersect(Columns(1), Range(Target.Address)) Is Nothing Then
       
'permit type
    ElseIf Not Application.Intersect(Columns(2), Range(Target.Address)) Is Nothing Then
'Stop
        bval = Target.Value
        ptype = bval
        If Left(bval, 1) Like "F*" Then
            msg1 = "Field "
            If Right(bval, 1) = "R" Then
                msg1 = "Regular"
            Else
                msg2 = "Tournament"
            End If
            msg3 = msg1 & " " & msg2
            With ws_pdata
                .Unprotect
                .Columns("G:L").Hidden = False
                .Columns("M:Y").Hidden = True 'diamond
                .Columns("Z:AC").Hidden = False 'field
                .Columns("AD:AG").Hidden = True 'court
                .Columns("AH:AS").Hidden = True 'greenspace
                .Columns("AT:AX").Hidden = True 'trail
                .Columns("AY:BD").Hidden = True 'events
                .Columns("BE:BG").Hidden = True 'expansion
                .Columns("BH:BJ").Hidden = False 'Other
                .Columns("BK:BO").Hidden = True 'grist mill
                .Protect
            End With
        ElseIf Left(bval, 1) = "D*" Then
            msg1 = "Diamond "
            If Right(bval, 1) = "R" Then
                msg1 = "Regular"
            Else
                msg2 = "Tournament"
            End If
            msg3 = msg1 & " " & msg2
        ElseIf Left(bval, 1) = "C*" Then
            msg1 = "Court "
            If Right(bval, 1) = "R" Then
                msg1 = "Regular"
            Else
                msg2 = "Tournament"
            End If
            msg3 = msg1 & " " & msg2
        ElseIf Left(bval, 1) = "TR" Then
            msg3 = "Trail Rental"
        ElseIf bval = "GS" Then
            msg1 = "Green Space "
        ElseIf bval = "GM" Then
            msg3 = "Grist Mill "
        Else
            msg3 = "Special Event"
        End If
        With ws_pdata
            .Unprotect
            .Cells(6, 3).Locked = False
            .Select
            .Protect
        End With
       
'active vs passive bookings
    ElseIf Not Application.Intersect(Columns(3), Range(Target.Address)) Is Nothing Then
Stop
        cval = Target.Value
        If cval = "A/P" Then
            Application.EnableEvents = False
                With ws_pdata
                    .Cells(6, 1) = pnum & "a"
                    .Rows(7).EntireRow.Insert
                    .Cells(7, 1) = pnum & "p"
                End With
            Application.EnableEvents = True
        End If
        With ws_pdata
            .Unprotect
            .Cells(6, 4).Locked = False
            .Select
            .Protect
        End With
       
    ElseIf Not Application.Intersect(Columns(4), Range(Target.Address)) Is Nothing Then
Stop
        dval = Target.Value
        With ws_pdata
            .Unprotect
            .Cells(6, 5).Locked = False
            .Select
            .Protect
        End With
       
'event name
    ElseIf Not Application.Intersect(Columns(5), Range(Target.Address)) Is Nothing Then
Stop
        eval = Target.Value
        With ws_pdata
            .Unprotect
            .Cells(6, 6).Locked = False
            .Select
            If ptype Like "D*" Then
                wn = "D_FUNC"
                If cval = "A" Then
                    Set rng_flist = ws_lists.Range("N2:N7")
                Else
                    Set rng_flist = ws_lists.Range("O2:O2")
                End If
            ElseIf ptype Like "F*" Then
                wn = "F_FUNC"
                If cval = "A" Then
                    Set rng_flist = ws_lists.Range("P2:P7")
                Else
                    Set rng_flist = ws_lists.Range("Q2:Q2")
                End If
            ElseIf ptype Like "C*" Then
                wn = "C_FUNC"
                If cval = "A" Then
                    Set rng_flist = ws_lists.Range("R2:R7")
                Else
                    Set rng_flist = ws_lists.Range("S2:S2")
                End If
            ElseIf ptype = "TR" Then
                wn = "T_FUNC"
                Set rng_flist = ws_lists.Range("T2:T5")
            ElseIf ptype = "GM" Then
                wn = "GM_FUNC"
                Set rng_flist = ws_lists.Range("U2:U5")
            ElseIf ptype = "GS" Then
                wn = "GS_FUNC"
                Set rng_flist = ws_lists.Range("V2:V6")
            Else
                wn = "SE_FUNC"
                Set rng_flist = ws_lists.Range("W2:W3")
            End If
            .Cells(6, 6).Locked = False
            .Range("F6").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=rng_flist
            .Select
            .Protect
        End With

    End If
End Sub

Follow along with me. The user is faced with the protected worksheet with all cells locked. A click of a macro enabled button inserts a blank row at row 6 and select cell A6. The user enters a value which is checked by cell validation. If it checks out, the attached code sends the focus to cell B6. This cell has list validation. The user selects from the list, and tabs or enters. It is supposed to send the user automatically to cell B3, like it did for B2 after a value was entered into B1. But it's not. The user has to click on the cell to reveal it's validation list. The rest of the column changes behave similar. After a valid entry is received, it's supposed to send the user to the next cell.

Please enlighten me as to why this isn't behaving as I am hoping.

BONUS QUESTION:
I am trying to populate cell F6 with a validation list based on range set in the code (rng_flist). Of course I'm getting an error. Not sure what I need to do to reflect the proper list values in the line:
Code:
.Range("F6").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=rng_flist
 
Last edited:

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Perhaps if I specified the cells needing to be selected would be the answer. :-)
 
Upvote 0

Forum statistics

Threads
1,223,937
Messages
6,175,510
Members
452,650
Latest member
Tinfish

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top