VBA Combo-Box
These are comboboxes on a userform?
If yes, you don't need to name the range. You could just refer to the range
itself:
Option Explicit
Private Sub UserForm_Initialize()
Dim iCtr As Long
Dim myCols As Variant
Dim myCBNames As Variant
Dim myRng As Range
myCols = Array("B", "F", "G", "H", "I", "E")
myCBNames = Array("cbCust", "cbMnth", "cbCons", _
"cbType", "cbReason", "cbSatus")
For iCtr = LBound(myCols) To UBound(myCols)
With Sheet3
.Range(.Cells(1, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp)) _
.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:="", _
CopyToRange:=Sheet4.Cells(1, myCols(iCtr)), _
Unique:=True
End With
With Sheet4
'avoid the header here
Set myRng = .Range(.Cells(2, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp))
'not needed
'myRng.name = myCBNames(ictr)
With myRng
'no header in that range
.Cells.Sort Key1:=.Cells(1, 1), _
Order1:=xlAscending, Header:=xlNo
End With
'avoid empty cells, so resize the range
Set myRng = .Range(.Cells(2, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp))
Me.Controls(myCBNames(iCtr)).RowSource _
= myRng.Address(external:=True)
End With
Next iCtr
End Sub
And just another way. I'd create the temporary worksheet on the fly and drop
the names--just use the values.
Option Explicit
Private Sub UserForm_Initialize()
Dim iCtr As Long
Dim myCols As Variant
Dim myCBNames As Variant
Dim myRng As Range
Dim TempWks As Worksheet
Application.ScreenUpdating = False
Set TempWks = Worksheets.Add
myCols = Array("B", "F", "G", "H", "I", "E")
myCBNames = Array("cbCust", "cbMnth", "cbCons", _
"cbType", "cbReason", "cbSatus")
For iCtr = LBound(myCols) To UBound(myCols)
With Sheet3
.Range(.Cells(1, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp)) _
.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:="", _
CopyToRange:=TempWks.Cells(1, myCols(iCtr)), _
Unique:=True
End With
With TempWks
'avoid the header here
Set myRng = .Range(.Cells(2, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp))
With myRng
'no header in that range
.Cells.Sort Key1:=.Cells(1, 1), _
Order1:=xlAscending, Header:=xlNo
End With
'avoid empty cells, so resize the range
Set myRng = .Range(.Cells(2, myCols(iCtr)), _
.Cells(.Rows.Count, myCols(iCtr)).End(xlUp))
Me.Controls(myCBNames(iCtr)).List = myRng.Value
End With
Next iCtr
Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
======
Another problem you were going to have is with the .currentregion.
Columns F, G and H are adjacent. So the current region would be determined by
all of them when you were doing column I.
NPell wrote:
Can anyone help, this isnt working, and i cant for the life of me work
out why.
With Sheet3
myRng = Array("B", "F", "G", "H", "I", "E")
myCB = Array("cbCust", "cbMnth", "cbCons", "cbType", "cbReason",
"cbSatus")
i = LBound(myRng)
For Each Rng In myRng
.Range(Rng & "1", .Range(Rng & "65536").End
(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="",
CopyToRange:=Sheet4.Range(Rng & "1"), Unique:=True
Sheet4.Range(Rng & "1").CurrentRegion.Offset(1, 0).Name = myCB
(i)
i = i + 1
Range(myCB).Sort Key1:=Sheet4.Range(myCB).Cells(1, 1),
Order1:=xlAscending, Header:=xlYes
myCB(i).RowSource = myCB(i)
Next Rng
End With
The idea behind it is to add unique records to each of the Combo
boxes, by copying from Sheet3 to Sheet4 to create a unique "behind the
scenes" list.
Thanks in advance if you can help.
--
Dave Peterson
|