tags:

views:

858

answers:

2

Can you create an Excel VBA function that returns an array in the same manner as LINEST does, for example? I would to create one that, given a supplier code, returns a list of products for that supplier from a product-supplier table.

TIA Bob Irving

A: 

I think Collection might be what you are looking for.

Example:

Private Function getProducts(ByVal supplier As String) As Collection
    Dim getProducts_ As New Collection

    If supplier = "ACME" Then
        getProducts_.Add ("Anvil")
        getProducts_.Add ("Earthquake Pills")
        getProducts_.Add ("Dehydrated Boulders")
        getProducts_.Add ("Disintegrating Pistol")
    End If

    Set getProducts = getProducts_
    Set getProducts_ = Nothing
End Function

Private Sub fillProducts()
    Dim products As Collection
    Set products = getProducts("ACME")
    For i = 1 To products.Count
        Sheets(1).Cells(i, 1).Value = products(i)
    Next i
End Sub

Edit: Here is a pretty simple solution to the Problem: Populating a ComboBox for Products whenever the ComboBox for Suppliers changes it's value with as little vba as possible.

Public Function getProducts(ByVal supplier As String) As Collection
    Dim getProducts_ As New Collection
    Dim numRows As Long
    Dim colProduct As Integer
    Dim colSupplier As Integer
    colProduct = 1
    colSupplier = 2

    numRows = Sheets(1).Cells(1, colProduct).CurrentRegion.Rows.Count

    For Each Row In Sheets(1).Range(Sheets(1).Cells(1, colProduct), Sheets(1).Cells(numRows, colSupplier)).Rows
        If supplier = Row.Cells(1, colSupplier) Then
            getProducts_.Add (Row.Cells(1, colProduct))
        End If
    Next Row

    Set getProducts = getProducts_
    Set getProducts_ = Nothing
End Function

Private Sub comboSupplier_Change()
    comboProducts.Clear
    For Each Product In getProducts(comboSupplier)
        comboProducts.AddItem (Product)
    Next Product
End Sub

Notes: I named the ComboBox for Suppliers comboSupplier and the one for Products comboProducts.

marg
Like this?Function FoundProds(SuppKey As Variant) As VariantDim ProdCell As RangeDim SuppCell As RangeDim Results(50)Dim ResultCount As IntegerDim ProdCol, SuppCol As IntegerProdCol = 1 'Product Code in this column'SuppCol = 2 'Supplier Codes are in this column'ResultCount = 1For Each ProdCell In Range(Cells(1, ProdCol), Cells(ActiveSheet.UsedRange.Rows.Count, ProdCol)) If SuppKey = SuppCell.Value Then Results(ResultCount) = Cells(ProdCell.Row, ProdCol).Value ResultCount = ResultCount + 1 End If Next FoundLocations = ResultsEnd Function
Bob Irving
I forgot to ask: You want to return the array to another VBA function right? or do you want to use the function directly in your worksheet as a custom function?
marg
I'd like to use the function directly in the worksheetI'm trying to let the user choose a supplier from a combo box, which will then populate a second combo box with that supplier's products, for a second choice. Sorry about the messy lump of code in my comment above!
Bob Irving
Are we talking about a control or a list created through an named range inserted to validation criteria? If it's a control you just need to put a sub in the SupplierCombobox_Change event and if it's a validation rule I believe we need to work with a named range
marg
It's a control. Though I am trying to avoid too much VBA as I will have to present this spreadsheet to some less IT literate people, so I would prefer not bury things in events and sich-like.... They might cope with a user-defined function.
Bob Irving
I added a solution which should work.
marg
+1  A: 

ok, here I have a function datamapping that returns an array of multiple 'columns', so you can shrink this down just to one. Doesn't really matter how the array gets populated, particularly

Function dataMapping(inMapSheet As String) As String()

   Dim mapping() As String

   Dim lastMapRowNum As Integer

   lastMapRowNum = ActiveWorkbook.Worksheets(inMapSheet).Cells.SpecialCells(xlCellTypeLastCell).Row

   ReDim mapping(lastMapRowNum, 3) As String
   For i = 1 To lastMapRowNum
      If ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 1).Value <> "" Then
         mapping(i, 1) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 1).Value
         mapping(i, 2) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 2).Value
         mapping(i, 3) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 3).Value
      End If
   Next i

   dataMapping = mapping

End Function




Sub mysub()

   Dim myMapping() As String

   myMapping = dataMapping(inDataMap)

   For m = 1 To UBound(inMapping)

     ' do some stuff

   Next m   

end sub
moleboy