Validation (List) Failing To Applied To Cell

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am trying to apply a validation list (dropdown) to a cell using this following code (snippit of larger procedure)

VBA Code:
       '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?
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,714
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
It should be: Formula1:="=nr_dsr_sig"

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

Code:
rng_dsr_sig.Name = "rng_dsr_sig"
 
Solution

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
You guys are the best! Thanks for being so quick to reply with the obvious solution!!
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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 ...

VBA Code:
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 ...

VBA Code:
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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,714
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

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

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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.

Rich (BB code):
 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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,714
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You still aren't deleting any existing validation first.

I assume the sheet isn't protected?
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,871
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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 ...

Code:
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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,714
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You'll have to unprotect the sheet to add validation.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,930
Messages
5,639,054
Members
417,067
Latest member
rohitbabshet

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
Top