Help needed - populating comboboxes from list??
 

Phillip London UK
This will fill both combo boxes

Assumptions before you run the code
Your data fills A1 to column F whatever row
as per your demo data
Range name this data range Database

This range name should be dynamic if
you want the code to work with expanding
or contracting data but for the purposes of this demo
leave it fixed and then change it later to dynamic

In H1 enter Calc In I2 enter Calc1
Range name H1:I2 Criteria
copy cells A1 to J1, C1 to K1 and F1 to L1
Range name J1:L1 Extract
you can can then hide columns H to L if you want

create a userform named userform1 with 2 comboboxes
combobox1 and combox2 each with 3 columns set as a property

Sub FillCombos()
Dim RngCombo As Range
Dim rngCrit As Range
Dim rngExtract As Range
Dim RngFormula As Range
Dim RngData As Range
Dim ColumnKnt As Integer
Dim RowKnt As Long

Set rngCrit = Range("Criteria")
Set rngExtract = Range("Extract")
Set RngData = rngExtract.Cells(1).Offset(1)
Set RngFormula = rngCrit.Rows(2).Cells(1)
ColumnKnt = rngExtract.Columns.Count


RngFormula.Formula = "=NOT(ISBLANK(E2))"
RngFormula.Offset(0, 1).Formula = "=ISBLANK(F2)"

Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCrit, _
CopyToRange:=rngExtract

Load UserForm1

If RngData.Value = "" Then
MsgBox "No data for combo1 "
Else
RowKnt = rngExtract.Cells(1).End(xlDown).Row - rngExtract.Row
Set RngCombo = RngData.Resize(RowKnt, ColumnKnt)
UserForm1.ComboBox1.List = RngCombo.Value
End If

RngFormula.Formula = "=C2<today()"

Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCrit, _
CopyToRange:=rngExtract

If RngData.Value = "" Then
MsgBox "No data for combo2 "
Else
RowKnt = rngExtract.Cells(1).End(xlDown).Row - rngExtract.Row
Set RngCombo = RngData.Resize(RowKnt, ColumnKnt)
UserForm1.ComboBox2.List = RngCombo.Value
End If

UserForm1.Show
End Sub