Wierd data into combo box
Posted by Phil Leaper on February 09, 2001 9:03 AM
Hi, I'm in a bit if strife and I was wondering if anyone could help.
I have a 3 sheets in my workbook, one of which is called Suppliers which contains a list of company addresses spaced exactly 9 rows apart (5 lines of address and 4 of space)(I don't know why they did it like that, but there are too many entries to change easily). I need to get the first lines of each of the addresses into a combo box in a sheet called Input. How do I state 'only retrieve every 9th row', in macro form, and how do I populate the combo box with the returned data
Thanks Phil
Posted by Dave Hawley on February 09, 2001 9:35 PM
Hi Phil
Here is some code that will create a named range ("MyRange") from every 9th row and then set Combobox1 on userform1 to be filld with this range.
You could of course use a simple loop to do this but as you have a long list it would not be anywhere near as quick.
Sub CreateComboList()
Dim EndCell As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Create a hidden sheet called "datasheet" if needed
On Error Resume Next
Sheets.Add().Name = "datasheet"
If ActiveSheet.Name <> "datasheet" Then ActiveSheet.Delete
'Sheets("datasheet").Visible = xlVeryHidden
Sheets("datasheet").Columns(1).Clear
Application.DisplayAlerts = True
On Error GoTo 0
With Sheet1
'Set "EndCell" to the last row in Column A
EndCell = .Columns(1).Find _
(What:="*", After:=.Cells(65536, 1), _
SearchDirection:=xlPrevious).Row
'Put =IF(MOD(ROW(),9)=0,A2,NA()) in cell B1
.Cells(1, 2) = "=IF(MOD(RC[-1],9)=0,RC[-1],NA())"
'Fill down to EndRow
.Cells(1, 2).AutoFill Destination:= _
.Range("B1:B" & EndCell)
'Copy and paste special to remove all formulas.
.Columns(2).Copy
.Columns(2).PasteSpecial xlValues
'Remove all NA cells
.Columns(2).SpecialCells _
(xlCellTypeConstants, xlErrors).Clear
'Copy again so we only have every ninth row _
and paste in column A of "datasheet"
.Columns(2).SpecialCells _
(xlCellTypeConstants).Copy _
Destination:=Sheets("datasheet").Cells(1, 1)
'Clear all traces
.Columns(2).Clear
End With
'Clear clipboard
Application.CutCopyMode = False
'Add the name MyRange and set it to our new list
ActiveWorkbook.Names.Add _
Name:="MyRange", RefersTo:="=datasheet" & _
"!" & Sheets("datasheet").Cells _
(1, 1).CurrentRegion.Address
'Set Combobox list to new range "MyRange"
UserForm1.Combobox1.RowSource = MyRange
Application.ScreenUpdating = True
End Sub
Hope it helps
Dave
OzGrid Business Applications
Posted by Dave Hawley on February 09, 2001 10:03 PM
USE THIS ONE INSTEAD
Phil, I just re-read your question and I Think this one is better suited to you. It applies to a Combobox from the Control Toolbox (not Forms) called Combobox1 which is on the sheet "Suppliers". It will also include row 1 of Column A in you list.
If you need any help, just shout.
Sub CreateComboList()
Dim EndCell As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Create a hidden sheet called "datasheet" if needed
On Error Resume Next
Sheets.Add().Name = "datasheet"
If ActiveSheet.Name <> "datasheet" Then ActiveSheet.Delete
Sheets("datasheet").Visible = False
Sheets("datasheet").Columns(1).Clear
Application.DisplayAlerts = True
On Error GoTo 0
With Sheets("Suppliers")
'Set "EndCell" to the last row in Column A
EndCell = .Columns(1).Find _
(What:="*", After:=.Cells(65536, 1), _
SearchDirection:=xlPrevious).Row
'Put =IF(OR(MOD(ROW(),9)=0,ROW()=1),A1,NA()) in cell B1
.Cells(1, 2) = "=IF(OR(MOD(ROW(),9)=0,ROW()=1),RC[-1],NA())"
'Fill down to EndRow
.Cells(1, 2).AutoFill Destination:= _
.Range("B1:B" & EndCell)
'Copy and paste special to remove all formulas.
.Columns(2).Copy
.Columns(2).PasteSpecial xlValues
'Remove all NA cells
.Columns(2).SpecialCells _
(xlCellTypeConstants, xlErrors).Clear
'Copy again so we only have every ninth row _
and paste in column A of "datasheet"
.Columns(2).SpecialCells _
(xlCellTypeConstants).Copy _
Destination:=Sheets("datasheet").Cells(1, 1)
'Clear all traces
.Columns(2).Clear
'Clear clipboard
Application.CutCopyMode = False
'Add the name MyRange and set it to our new list
ActiveWorkbook.Names.Add _
Name:="MyRange", RefersTo:="=datasheet" & _
"!" & Sheets("datasheet").Cells _
(1, 1).CurrentRegion.Address
'Set Combobox list to new range "MyRange"
.ComboBox1.ListFillRange = "MyRange"
End With
Application.ScreenUpdating = True
End Sub
Good luck
OzGrid Business Applications
