VBA Validation List set

Hello People. Good to be back on the forum. Sadly i have a problem I am having trouble with. Spent a couple of hours on it but still wrong. I have a range of cells in column A which have a formula to take the value of another cell. I need my validation list to pick up any new data in the column but because 'ignore blanks' doesnt ignore cells with formulas I need to expand my validation list range every time a new value is entered to the last cell in column a. This is what I have but its not working. I have added conditional comments so hop it will be clear. Can anyone offer me help please.

Code:

---

Private Sub CommandButton1_Click()

'set last cell as range then set New Validation list range
Dim LastCell As Range
Dim ValListRange As Range
Set LastCell = Cells(Application.Evaluate("MAX(IF(A201:A2000<>"""",ROW(A201:A2000)),0,1)"), "A")
Set ValListRange = Range("A201", LastCell)

With Range("C9:E9").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValListRange
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With

Application.ScreenUpdating = True

End Sub

---

Quote:

---

Originally Posted by xander1981

Hello People. Good to be back on the forum. Sadly i have a problem I am having trouble with. Spent a couple of hours on it but still wrong. I have a range of cells in column A which have a formula to take the value of another cell. I need my validation list to pick up any new data in the column but because 'ignore blanks' doesnt ignore cells with formulas I need to expand my validation list range every time a new value is entered to the last cell in column a. This is what I have but its not working. I have added conditional comments so hop it will be clear. Can anyone offer me help please.

Code:

---

Private Sub CommandButton1_Click()

'set last cell as range then set New Validation list range
Dim LastCell As Range
Dim ValListRange As Range
Set LastCell = Cells(Application.Evaluate("MAX(IF(A201:A2000<>"""",ROW(A201:A2000)),0,1)"), "A")
Set ValListRange = Range("A201", LastCell)

With Range("C9:E9").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValListRange
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With

Application.ScreenUpdating = True

End Sub

---

---

You can replace the lines of code I highlighted in red with the following and ValListRange will automatically be calculated without your having to update the ranges in Column A...

Code:

---

  Dim ValListRange As Range
  Set ValListRange = Range("A201", Columns("A").Find(What:="*", SearchOrder:=xlRows, _
                    SearchDirection:=xlPrevious, LookIn:=xlValues))

---

Does that help you any?

Edit Note: Just to point out, though, the above code assumes there is something in cell A201 or later. If that cannot be guaranteed, let me know and I'll modify the code to lock at cell A201 if there is no data in any of the cells at or after A201.

Sorry to be such a Newby Rick. Can't get it to run through correctly. Can you spot my problem? This is my whole code.

Code:

---

Private Sub CommandButton1_Click()

Dim dd As Worksheet
Dim FCL As Worksheet
Dim LCL As Worksheet
Dim supSht As Worksheet
Dim cellNameRng As Range
Dim cellEmailRng As Range

Set dd = Worksheets("Double Drop FCL")
Set FCL = Worksheets("FCL")
Set LCL = Worksheets("LCL")
Set supSht = Worksheets("Supplier | emails")

Application.ScreenUpdating = False

' Find next available cell in column A (Haulier name)
supSht.Visible = xlSheetVisible
supSht.Select

Range("A2").Select
        Do Until ActiveCell.Row = 65536
        Selection.End(xlDown).Select
        Loop
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ' --------------------------------
       
'set the blank cell to use for next name
Set cellNameRng = ActiveCell
       
'Take name from form and paste to next cell in Supplier sheet
cellNameRng = NewSupplier.TextBoxName.Value

' Find next available cell in column B (email address)
Range("B2").Select
        Do Until ActiveCell.Row = 65536
        Selection.End(xlDown).Select
        Loop
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ' --------------------------------
       
'set the blank cell to use for next email address
Set cellEmailRng = ActiveCell
       
'Take email from form and paste to next cell in Supplier sheet
cellEmailRng = NewSupplier.TextBoxemailAdd.Value

'Clear the namebox from form
NewSupplier.TextBoxName.Value = ""
'Clear the namebox from form
NewSupplier.TextBoxemailAdd.Value = ""

'Filter haulier name to alphabetical ascending order
Range("A1:B600").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Hide the form
NewSupplier.Hide

'Hide Supplier sheet
supSht.Visible = xlSheetHidden

ActiveSheet.Unprotect

'expand validation list to the row with new values in

Dim ValListRange As Range
Set ValListRange = ActiveSheet.Range("A201", Columns("A").Find(What:="*", SearchOrder:=xlRows, _
                    SearchDirection:=xlPrevious, LookIn:=xlValues))

With Range("C9:E9").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValListRange
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
   
ActiveSheet.Protect

Application.ScreenUpdating = True

Set dd = Nothing
Set FCL = Nothing
Set LCL = Nothing
Set supSht = Nothing
Set cellNameRng = Nothing
Set cellEmailRng = Nothing

End Sub

---

p.s. Cell A201 will always be populated thank you. Thanks for your help

HI,

The code is finding error with:

Code:

---

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValListRange

---