Solved: array function help

hi,
I have a user form with many combo boxes.
All my combo box list items are extracted from another workbooks.

Eg. for combo box 1:

Code:

---

Workbooks.Open (.....)
 Set DB = ActiveWorkbook
 RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
DB_RANGE = "A2:A" & RowCount

 With Me.ComboBox1
    For Each listMaterialType In Worksheets("Sheet1").Range(DB_RANGE)
        .AddItem listMaterialType.Value
        .List(.ListCount - 1, 1) = listMaterialType.Offset(0, 1).Value
    Next listMaterialType
End With
DB.Close False

---

This work fine. But when i want to do it for many combo boxes, I find that there are many repeat codes. Can someone show me how to make this code into a function to return array and use it in combo box 1, combo box2 ...etc? Many thanks.

Hi there,

A bit of a stab, as I'm not sure I understand. If I do, and you have the combo boxes named as shown, maybe:

Code:

---

Dim i As Long
   
    For i = 1 To 20 '<---however many comboboxes
   
        'Workbooks.Open (.....)
        Set Db = ActiveWorkbook
        RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
        DB_RANGE = "A2:A" & RowCount
       
        With Me.Controls("ComboBox" & i)
            For Each listMaterialType In Worksheets("Sheet1").Range(DB_RANGE)
                .AddItem listMaterialType.Value
                .List(.ListCount - 1, 1) = listMaterialType.Offset(0, 1).Value
            Next listMaterialType
        End With
        Db.Close False
    Next

---

Hope that helps,

Mark

Thanks GTO,
but this is what i have in mind:

Code:

---

sub a()
wbk=1.xls
arrayA = call function(wbk)
using loop to assign arrayA to combo box 1 items

wbk=2.xls
arrayB = call function(wbk)
using loop to assign arrayB to combo box 2 items

wbk=3.xls
arrayC = call function(wbk)
using loop to assign arrayC to combo box 3 items
...
....

end sub

function(wbk)
Workbooks.Open (wbk)
 Set DB = ActiveWorkbook
 RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
DB_RANGE = "A2:A" & RowCount

 For Each listMaterialType In Worksheets("Sheet1").Range(DB_RANGE)
    assign values to array
End With
DB.Close False
end function

---

Do you know how to do it this way? I tried but failed.

It appears to me that you have a two-column combo. You should not need to loop in the values, especially given that they are coming from an array.

Not sure if you are hard-coding in the wb names/paths, but see if this example helps.

In the Userform's Module:

Code:

---

Option Explicit
   
Private Sub UserForm_Initialize()
   
Const PATH As String = "D:\2010\_Tmp\2010-09-17\tmp\"
               
    With Me.ComboBox1
        .List = RetArray(PATH & "New Microsoft Excel Worksheet.xls")
    End With
   
    With Me.ComboBox2
        .List = RetArray(PATH & "New Microsoft Excel Worksheet (2).xls")
    End With
End Sub
   
Private Function RetArray(strFullPath As String) As Variant()
Dim wks As Worksheet
   
    Set wks = Workbooks.Open(strFullPath, , True).Worksheets("Sheet1")
    RetArray = wks.Range(wks.Range("A2"), _
                        wks.Cells(wks.Rows.Count, "A").End(xlUp) _
                        ).Resize(, 2).Value
    wks.Parent.Close False
End Function

---

Dear GTO,
Do you know how to use 2-dimension array to solve this?

I tried to use pre-defined array in my code for testing:

Code:

---

comboBoxList = Array("James", "Mary", "Tom", "Beth", "Bob", "Chris", "Daniel", "Lari", "Al", "Teresa")

---

On the "VBA editor - watches", it display
MyArray(0) : "James"
MyArray(1) : "Mary"
...
...

Then i tried to extract data from worksheet to form an array:

Code:

---

comboBoxList = Worksheets(1).Range("A:A").Value

---

On the "VBA editor - watches", it display
MyArray(1)
MyArray(1,1) : "James"
MyArray(2)
MyArray(2,1) : "Mary"
...
...

Is there a difference between the 2 arrays as i can't perform array sorting.

Quote:

---

Originally Posted by benong

Dear GTO,
Do you know how to use 2-dimension array to solve this?

---

Quote:

---

Originally Posted by GTO

Code:

---

Private Function RetArray(strFullPath As String) As Variant()
Dim wks As Worksheet
 
    Set wks = Workbooks.Open(strFullPath, , True).Worksheets("Sheet1")
    RetArray = wks.Range(wks.Range("A2"), _
                        wks.Cells(wks.Rows.Count, "A").End(xlUp) _
                        ).Resize(, 2).Value
    wks.Parent.Close False
End Function

---

---

RetArray returns a two-dimiensional array. Did you try the code?

In the case of RetArray, as we resized from column A and grabbed Column B, the array contains however many rows of data in Col A, by two columns.

Your second array is also a two-dimensional array, in this case, only one column. So that is, it is a however many rows, by 1 to 1 columns. This is why under watches or the locals window, it shows MyArray(1,1) James. The first one is the row, the second is the column.

Dear GTO,
Sorry, I'm not comfortable with array, but finally, i get this to work.

Code:

---

Private Sub UserForm_Initialize()
    With Me.ComboBox1
        .List = remoteComboBoxList("1.xlsx", "B")
    End With

    With Me.ComboBox2
        .List = remoteComboBoxList("2.xlsx", "A")
    End With

    With Me.ComboBox3
        .List = remoteComboBoxList("3.xlsx", "G")
    End With
End Sub

Function remoteComboBoxList(DB_Workbook As String, columnField As String) As Variant()
    Dim wbk As Workbook
    Dim RowCount As Integer
    Dim DB_RANGE As String

    Application.ScreenUpdating = False    'hide source book from user

    Workbooks.Open DB_Path & DB_Workbook
    Set wbk = ActiveWorkbook
    RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
    DB_RANGE = columnField & "2:" & columnField & RowCount

    wbk.Worksheets("Sheet1").Range("A1").Sort _
        Key1:=Worksheets("Sheet1").Columns(columnField), _
        Header:=xlGuess

    remoteComboBoxList = wbk.Worksheets("Sheet1").Range(DB_RANGE).Value

    wbk.Close False
    Application.ScreenUpdating = True
End Function

---

It does fullfil some of my objective, but i need it to further enhance it to allow 2 column values. So far i've not succeed.

Dear GTO,

many thanks for your guidance and patience.
You code is working great :)

Quote:

---

Originally Posted by benong

Dear GTO,

many thanks for your guidance and patience.
You code is working great :)

---

Happy to help and glad its working:friends: