Populate Excel Data Validation Drop-Down From Data Range Condition Using VBA

Question

I am building a spreadsheet which contains data validation drop-downs for users to select. The dropdown is populated from a named range on a (hidden) tab based on some predefined conditions.

The an extract of the data range (which is currently >500 rows) is

| Type | Code | Description      | Start Date | End Date   | Status |
| A    | 001  | IT               | 01/01/2016 | 31/12/2016 | O      |
| A    | 002  | HR               | 31/10/2017 | 31/12/2018 | O      |
| A    | 003  | Payrol           | 01/01/2016 | 31/12/2016 | O      |
| A    | 004  | Marketing        | 01/01/2016 | 31/12/2016 | C      |
| B    | 110  | Technical Review | 01/01/2016 | 31/12/2016 | O      |

And is in a Named Range 'Code Data'

I am wanting to populate a data validation dropdown with the code column using VBA from the data range where:

• Type = A
• Status = O
• Start Date < Today's date
• End Date > Today's date

I have attempted using ODBC/SQL which works well but is slow to start up – I assume it's making it's connection to the data range before querying

Is there a faster/better way?

Answer 1

I think data validation needs a continuous range, so you'll probably need to filter first then move the resulting cells elsewhere, or the data validation will include the hidden cells, something like this (obviously amend to your own sheet and ranges):

Sub someMacro()
With Sheets("Sheet1")
    With .Range("a1:f6")
        .AutoFilter Field:=1, Criteria1:="A"
        .AutoFilter Field:=6, Criteria1:="O"
        .AutoFilter Field:=4, Criteria1:="<" & Date
        .AutoFilter Field:=5, Criteria1:=">" & Date
    End With
    .Range(.Range("b2"), .Range("b2").End(xlDown)).Copy
    .Range("g1").PasteSpecial xlPasteValues 'Put this whereever is suitable, don't forget to add something in to delete this with each run
    .Range("h1").Validation.Add Type:=xlValidateList, Formula1:="='Sheet1'!" & .Range(.Range("g1"), .Range("g1").End(xlDown)).Address 'I've validated cell h1, change this to whatever
End With
End Sub