Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,616
- Office Version
- 365
- 2016
- Platform
- Windows
I'm having some problems with how this code is misbehaving (as expected).
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:
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: