VBA Combo-Box

[NPell]

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]

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.