Populate a Multicolumn ComboBox with filtered range

[jrperez.munloiza]

I have a worksheet with 40 columns.

This is part of the worksheet:

-- A
B C
D .... BA
1 ID
BussinessType Name
City 1
2 123451
1 John Lennon New Orleans
3 123452
2 Luigi Federline Ontario
4 123453
1 Arthur Diaz Los Angeles
5 123454
2 Jane Lisboa Portland

I want to populate a 4-column combobox (within these columns) with
rows where BussinessType is equal to 1.


This is my Code:

'----Start Code----

Sub Populate_Combobox()

Dim rnData As Range
Dim vaData As Variant
Dim i As Long

With Sheet1

Set rnData = .Range(.Range("B1"), .Range("B65536").End(xlUp))

rnData.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range("BA1"), Unique:=True

vaData = .Range(.Range("BA2"), .Range("BA65536").End(xlUp)).Value

.Range(.Range("BA1"), .Range("BA65536").End(xlUp)).ClearContents

End With

With ComboBox1
.Clear
.List = vaData
.ListIndex = -1
End With

End Sub

'----End Code----


But this only works in a single column combobox, and still gives me
all the records.

What is the problem?

Juan

 

[Guest]

You need to have a criteria range that specifies to copy records with
Business Type 1.

To do the 4 columns

Sub Populate_Combobox()

Dim rnData As Range
Dim vaData As Variant
Dim i As Long
Dim CritRng as Range

With Sheet1
' Set up the criteria range
Set crtRng = .Range("F1:F2")
.Range("F1").Value = .Range("B2").Value
.Range("F2").Value = 1
Set rnData = .Range(.Range("A1"), .Range("A65536").End(xlUp)).Resize(,4)
' Put headers in row1
.Range("BA1").Resize(1,4).Value = .Range("A1").Resize(1,4).value
rnData.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=crtRng, _
CopyToRange:=.Range("BA1").Resize(1,4), _
Unique:=False

vaData = .Range(.Range("BA2"),
..Range("BA65536").End(xlUp)).Resize(,4).Value

.Range(.Range("BA1"), .Range("BA65536").End(xlUp)).ClearContents

End With

With ComboBox1
.Clear
.ColumnCount = 4
.List = vaData
.ListIndex = -1
End With
' clear out the criteria range
crtRng.clearcontents
End Sub

 

[jrperez.munloiza]

You need to have a criteria range that specifies to copy records with
Business Type 1.

To do the 4 columns

Sub Populate_Combobox()

Dim rnData As Range
Dim vaData As Variant
Dim i As Long
Dim CritRng as Range

With Sheet1
' Set up the criteria range
Set crtRng = .Range("F1:F2")
.Range("F1").Value = .Range("B2").Value
.Range("F2").Value = 1
Set rnData = .Range(.Range("A1"), .Range("A65536").End(xlUp)).Resize(,4)
' Put headers in row1
.Range("BA1").Resize(1,4).Value = .Range("A1").Resize(1,4).value
rnData.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=crtRng, _
CopyToRange:=.Range("BA1").Resize(1,4), _
Unique:=False

vaData = .Range(.Range("BA2"),
.Range("BA65536").End(xlUp)).Resize(,4).Value

.Range(.Range("BA1"), .Range("BA65536").End(xlUp)).ClearContents

End With

With ComboBox1
.Clear
.ColumnCount = 4
.List = vaData
.ListIndex = -1
End With
' clear out the criteria range
crtRng.clearcontents
End Sub

--
Regards,
Tom Ogilvy
























- Show quoted text -

I found the error. On the criteria range, the first value is of one of
the headers.

Set crtRng = .Range("F1:F2")
.Range("F1").Value = .Range("B1").Value ' It was pointing to the
first value instead of the header

Juan

 

[Tom Ogilvy]

How can B1 be the 1st value instead of the header?