CODEWITHSUNDEEP
arraysexcelvbauser-defined-functions
Michael James
Michael James

Reputation: 616

Excel VBA - Determining Column or Row Target of Array UDF

I have a simple excel UDF for converting an array of mass values to mol fractions. Most times, the output will be a column array (n rows by 1 column).

How, from within the VBA environment, do I determine the dimensions of the target cells on the worksheet to ensure that it should be returned as n rows by 1 column versus n columns by 1 row?

Function molPct(chemsAndMassPctsRng As Range)

Dim chemsRng As Range
Dim massPctsRng As Range
Dim molarMasses()
Dim molPcts()

Set chemsRng = chemsAndMassPctsRng.Columns(1)
Set massPctsRng = chemsAndMassPctsRng.Columns(2)

chems = oneDimArrayZeroBasedFromRange(chemsRng) 
massPcts = oneDimArrayZeroBasedFromRange(massPctsRng)

'oneDimArrayZeroBasedFromRange is a UDF to return a zero-based array from a range.

ReDim molarMasses(UBound(chems))
ReDim molPcts(UBound(chems))

totMolarMass = 0

For chemNo = LBound(chems) To UBound(chems)

    molarMasses(chemNo) = massPcts(chemNo) / mw(chems(chemNo))
    totMolarMass = totMolarMass + molarMasses(chemNo)

Next chemNo

For chemNo = LBound(chems) To UBound(chems)

    molPcts(chemNo) = Round(molarMasses(chemNo) / totMolarMass, 2)

Next chemNo

molPct = Application.WorksheetFunction.Transpose(molPcts)

End Function

I understand that, if nothing else, I could have an input parameter to flag if return should be as a row array. I'm hoping to not go that route.

Upvotes: 0

Views: 572

Answers (2)

Gary's Student
Gary's Student

Reputation: 96771

Here is a small example of a UDF() that:

  1. accepts a variable number of input ranges
  2. extracts the unique values in those ranges
  3. creates a suitable output array (column,row, or block)
  4. dumps the unique values to the area

Public Function ExtractUniques(ParamArray Rng()) As Variant
    Dim i As Long, r As Range, c As Collection, OutPut
    Dim rr As Range, k As Long, j As Long

    Set c = New Collection
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    '   First grab all the data and make a Collection of uniques
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
        For i = LBound(Rng) To UBound(Rng)
            Set r = Rng(i)
            For Each rr In r
                c.Add rr.Value, CStr(rr.Value)
            Next rr
        Next i
    On Error GoTo 0
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   '
   '    next create an output array the same size and shape
   '    as the worksheet output area
   '
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    k = 1
    With Application.Caller
        ReDim OutPut(1 To .Rows.Count, 1 To .Columns.Count)
    End With

    For i = LBound(OutPut, 1) To UBound(OutPut, 1)
        For j = LBound(OutPut, 2) To UBound(OutPut, 2)
            If k < c.Count + 1 Then
                OutPut(i, j) = c.Item(k)
                k = k + 1
            Else
                OutPut(i, j) = ""
            End If
        Next j
    Next i
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    '   put the data on the sheet
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ExtractUniques = OutPut
End Function

Upvotes: 1

z32a7ul
z32a7ul

Reputation: 3797

You should return two dimensional arrays: n × 1 for row and 1 × n for column vectors.

So you need either

Redim molPcts(1, Ubound(chems) + 1)

or

Redim molPcts(Ubound(chems) + 1, 1)

To refer to them, you need to use both indices:

molPcts(1, chemNo + 1)

or

molPcts(chemNo + 1, 1)

If you prefer 0-based arrays, the redim should be like this:

Redim molPcts(0 To 0, 0 To Ubound(chems))
Redim molPcts(0 To Ubound(chems), 0 To 0)

Upvotes: 0

Related Questions