Validation (List) Failing To Applied To Cell

[Ark68]

I am trying to apply a validation list (dropdown) to a cell using this following code (snippit of larger procedure)

       'part 1
       With ws_thold
            .Range("A2:A" & flcnt).Value = Range("I2:I" & flcnt).Value
            .Range("I" & flcnt + 1).Value = "NA"
            .Range("I" & flcnt + 2).Value = "NR"
            Set rng_dsr_sig = .Range("I2:I" & flcnt + 2)
            ThisWorkbook.Names.Add Name:="nr_dsr_sig", RefersTo:=rng_dsr_sig
        End With
        'part 2
        With ws_master.Cells(srow, 10)
            .Value = bn
            .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:=nr_dsr_sig
        End With

The first part is the creation of a named range based on a dynamic range of cells. The named range is "nr_dsr_sig"
The second part places a predetermined default value of bn into a cell in column J of worksheet ws_master, as a row defined by srow. It also attempts to add list validation (dropdown) to that same cell based comprised of the values in nr_dsr_sig.

It runs through the code without error, however, I am not getting the drop validation list. The worksheet is protected, but the cell is unlocked.

What is preventing me from getting the dropdown validation for that cell?

 

[RoryA]

It should be: Formula1:="=nr_dsr_sig"

Also, to name the range, you can just use:

rng_dsr_sig.Name = "rng_dsr_sig"

 

[Ark68]

You guys are the best! Thanks for being so quick to reply with the obvious solution!!

 

[Ark68]

OK ... I spoke too soon. Yes ... you guys are the best, but this still isn't working. It's not that your solution is wrong, but I think there is more to the problem than just the quotes.

Digging a bit deeper back into the code, I have a module that is called as a result of an if elseif endif situation ...

With ws_master
        nrec = Application.WorksheetFunction.CountA(.Range("C12:C37"))
        'if no records to assign, then proceed with dispatching services
        
        If nrec = 0 Then 'no records to assign
            MsgBox "No rentals to assign."
            'proceed to services assignments
            Stop
            Exit Sub
        End If
        
        'process default assignments for all bookings, one by one (srow loop)
        For srow = 13 To 12 + nrec  'source(ws_master) row
            btype = .Cells(srow, 2) 'booking type (DR,FR, CR etc)
            pnum = .Cells(srow, 3)  'permit number
            fac2 = .Cells(srow, 4)  'LABEL (col6) in core_data
            st = .Cells(srow, 6)    'start time
            Stop
            
            If btype Like "F*" Then
                signatures srow, pnum, fac2, nrec, st
                'lights
            ElseIf btype Like "D*" Then
                signatures srow, pnum, fac2, nrec, st
                'groom
                'prep
                'lights
                'tournament
                'close
            ElseIf btype Like "C*" Then
                signatures srow, pnum, fac2, nrec, st
                'groom
                'prepare
                'lights
                'close
            ElseIf btype Like "G*" Then
                signatures srow, pnum, fac2, nrec, st 'assignments
                'prepare
                'close
            ElseIf btype Like "T*" Then
                signatures srow, pnum, fac2, nrec, st
            ElseIf btype Like "S*" Then
                signatures srow, pnum, fac2, nrec, st
                'prepare
                'close
            Else
                MsgBox "Error: pda_assign1"
                Stop
            End If
'----> resumes here!
       Next srow
    End With

Consider btype = "DR". The Elseif btype like "D*" is met, and the procedure "Signatures" is called. All arguments have values.

Here is the "signatures" code ... which is where the code from my original problem resides ...

Sub signatures(srow As Integer, pnum As String, fac2 As String, nrec As Long, st As Variant)
    
    'signatures are assigned based on that facility's assigned crew and eligible shift
    'this assignmnet, whether a signature is required or not, determines the crew assignemnt of this booking
    'srow = the row on the master worksheet being analysed
    
    Dim cd_rrow As Integer 'the row that the current record resides in CORE_DATA
    mbevents = False
    Stop
    str_v1 = pnum & fac2 & Round(st, 3)

    'match row in core_data (step through rows 2 to the end of data (nrec+1) until match (str_v2) is found
    For v2 = 2 To nrec + 1
        str_v2 = ws_cd.Cells(v2, 17).Value & ws_cd.Cells(v2, 6) & Round(ws_cd.Cells(v2, 2), 3)
        If str_v1 = str_v2 Then
            MsgBox "All three criteria met with row : " & v2 'reference data will be from this row ie fac2
            Exit For
        End If
    Next v2
    
    cd_rrow = v2
        
    'DETERMINE FACILITY FAMILY (BP, HP, RP, WP, EV)
    str_family = ws_cd.Cells(cd_rrow, 10)
    'temp. populate master worksheet with that booking's (srow) facility family
    ws_master.Cells(srow, 10).Value = str_family
     
    'find the primary crew 1) a crew for that family, 2) next alternate
    With ws_thold
        Stop
        flcnt = Application.WorksheetFunction.CountA(.Columns(1)) 'count of scheduled employees from thold
        'ensure there are staff working
        If flcnt < 0 Then
            MsgBox "There is no staff scheduled to assign to any bookings."
            Stop 'CRITICAL ERROR : no staff to assign
        Else
            sc = 0 '0 = cleared 1 = successful assignment
            'check if a parent crew is scheduled
            For l2 = 2 To flcnt 'loop through each crew in crew list
                If str_family = Left(.Cells(l2, 1), 2) Then 'a parent has been identified, but does it fit into the shift (30 minutes after start -> 30 minutes before end)
                    sts = Round(.Cells(l2, 4), 3) + TimeSerial(0, 30, 0) 'parent shift start + 30 minutes
                    ste = Round(.Cells(l2, 5), 3) - TimeSerial(0, 30, 0) 'parent shift end - 30 minutes
                    MsgBox "Booking Start : " & Format(Round(st, 3), "h:mm AM/PM") & Chr(13) _
                        & "Parent crew : " & .Cells(l2, 1) & Chr(13) _
                        & "Can accomodate bookings starting between : " & Chr(13) _
                        & Format(sts, "h:mm AM/PM") & " : " & Format(ste, "h:mm AM/PM")
                    If Round(st, 3) >= sts And Round(st, 3) <= ste Then 'this shift is ok (st is carried in as the booking start time)
                        bn = .Cells(l2, 1) 'populate master booking with parent shift
                        sc = 1
                        Exit For
                    End If
                End If
            Next l2
            
            If sc <> 1 Then 'there is no parent crew scheduled that can accomodate this booking. Refer to next appropriate alternate
                Debug.Print str_family & " not on duty. Searching alternates list."
                altcol = Application.WorksheetFunction.Match(str_family, ws_lists.Range("AH3:Al3"), 0) + 33
                For l2 = 4 To 7 'cycle through order of alternates
                    str_alt = ws_lists.Cells(l2, altcol)
                    Debug.Print "Next alternative for consideration: " & str_alt
                    For l3 = 2 To flcnt 'find a matching alt in the employee coverage (thold)
                        Debug.Print "Assessing: " & Left(ws_thold.Cells(l3, 1), 2)
                        If str_alt = Left(ws_thold.Cells(l3, 1), 2) Then 'there is an alt available - check if within time
                            Debug.Print Left(ws_thold.Cells(l3, 1), 2) & " next available alternate."
                            sts = Round(ws_thold.Cells(l3, 4), 3) + TimeSerial(0, 30, 0) 'parent shift start
                            ste = Round(ws_thold.Cells(l3, 5), 3) - TimeSerial(0, 30, 0) 'parent shift end
                            MsgBox "Booking Start : " & Format(Round(st, 3), "h:mm AM/PM") & Chr(13) _
                                & "Alternate crew : " & str_alt & Chr(13) _
                                & "Can accomodate bookings starting between : " & Chr(13) _
                                & Format(sts, "h:mm AM/PM") & " : " & Format(ste, "h:mm AM/PM")
                            If Round(st, 3) >= sts And Round(st, 3) <= ste Then 'this shift is ok
                                bn = .Cells(l2, 1)
                                sc = 1
                                Exit For
                            End If
                        End If
                        If sc = 1 Then Exit For
                    Next l3
                    If sc = 1 Then Exit For
                Next l2
            End If
        End If
        Stop
        'ws_master
        'nr_dsr_sig
        With ws_thold
            .Range("I2:I" & flcnt).Value = .Range("A2:A" & flcnt).Value
            .Range("I" & flcnt + 1).Value = "NA"
            .Range("I" & flcnt + 2).Value = "NR"
            Set rng_dsr_sig = .Range("I2:I" & flcnt + 2)
            ThisWorkbook.Names.Add Name:="nr_dsr_sig", RefersTo:=rng_dsr_sig
        End With
    End With
    Stop ' *******
    With ws_master.Cells(srow, 10)
        .Value = bn
        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Formula1:="=nr_dsr_sig"
        '---> routine exits here 
    End With

    mbevents = True
End Sub

When I step through the code with F8, everything appears to be performing well. When the .validation.Add statement is stepped through, the routine exits (as noted) and resumes back in the calling code at the point identified with "'----> resumes here!" So, the 'signatures' code never ends (when I would want it to end), nor does the cell get the validation list applied.

So something is a miss ... I think. Hopefully I've provided enough to isolate the problem. If not, and there's something I can try to reveal, please ask.

 

[RoryA]

First off, you should always clear the existing validation before you try to add one.

Second, is this code being run in response to an event?

 

[Ark68]

Hi Rory ... I thought I had replied to this, but it looks like I forgot to submit.

Yes, all validations associated with that worksheet will have (should have) been removed as part of a worksheet "initialization" prior to it's population of data and re-validation.

In response to an event? Referring to perhaps a button click or some sort of change? I don't think so. Its all part of a grand process. I have a range of cells that get individually processed, and assigned a validation based on the value that cell was populated with. Not sure if that helps. The worksheet does have some change events, so I have had to disable them from triggering by applying mbevents = false to the "signatures" module. It gets enabled at the end of the signatures routine, but it never gets there when it needs to. I tried putting re-enabling mbevents before the validation is applied rather than waiting till the end, but that didn't appear to make a difference.

 

[Ark68]

I found the culprit. I had used an error catch (On error resume next) in my code which was hiding my errors. So once I realized that and added On Error Goto 0) i discovered that I had an error in my validation line.

 With ws_master.Cells(srow, 10)
        .Value = bn
        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Formula1:="=nr_dsr_sig"
    End With

Line in red leaves me with an "Application-defined or object-defined error"
ws_master is a recognized worksheet, sdrow has a value. According to Name Manager, "nr_dsr_sig" is recognized, refers to the correct range of cells, and is populated.

 

[RoryA]

You still aren't deleting any existing validation first.

I assume the sheet isn't protected?

 

[Ark68]

The sheet is protected, but the cells (that are receiving the the value and validation are unlocked.) Perhaps I misunderstand what can and cannot be done to unprotected cells of protected worksheets. I assume I will have to set my protection up to allow formatting?

You still aren't deleting any existing validation first.

There are no validations to delete. They have been previously deleted ...

With rng_pda
       With .Cells
           .UnMerge
           .Validation.Delete
           .Font.Bold = False
           .Font.Color = vbBlack
           .Font.Italic = False
           .ClearContents
       End With
       brdr_pda 'reset borders
End With

 

[RoryA]

You'll have to unprotect the sheet to add validation.