UDF to Return Multiple Values

[AndyPandy27]

Hi Guys,

I have been searching for an answer to this on this forum, other ones similar, and in my MrExcel VBA and Macros 2010 book, but unfortunately I still haven't had any luck, so thought I would ask away.

Before I get into, I did find this thread - but it didn't quite cover what I wanted, so here goes...

I'm looking to create a UDF called ListItems which will look through a range and create a one column contiguous list of non-blank values.

e.g. below is Range("A1:C3") --> ignore the Column Headers, they're just included for visual reference.

Column A	Column B	Column C
John	Peter	Mary
Andy		Dave
Karen

<tbody>
</tbody>

If the user used =ListItems(A1:C3) in cell D1, the result would be:

Column D

John

Peter

Mary

Andy

Dave

Karen

<tbody>
</tbody>

Couple of things to consider:
1. I appreciate that the user would most likely have to confirm this function with Ctrl+Shift+Enter --> that is fine

2. A UDF might not be the most efficient/suitable solution to this "problem", but I'm currently learning about UDFs, so am more interesting in how they work, than determining the most elegant/correct way to resolve this issue.

3. The order of the resultant values which I have used above (i.e. reading the range passed to the UDF from left to right one row at a time), is not critical, if it is easier to read top to bottom one column at a time, that would be absolutely fine too.

Many thanks indeed,

AP

 

[mikerickson]

I would write a UDF that returned an array (like MMULT returns an array)

Function EliminateBlanks(aRange as Range) As Variant
    Dim arrResult() As String
    Dim oneCell as Range, Pointer As Long

    ReDim arrResult(1 to aRange.Cells.Count)

    For Each oneCell in aRange
        If oneCell.Text <> vbNullString Then
            Pointer = Pointer + 1
            arrResult(Pointer) = oneCell.Text
        End If
    Next oneCell

    EliminateBlanks = arrResult
End Function

Then you would select D1:D9 and enter the array formula
=TRANSPOSE(EliminateBlanks(A1:C3))

with Ctrl-Shift-Enter (Cmd+Return on Mac)

 

[AndyPandy27]

Hi Mike,

This is excellent, thank you very much indeed.

I changed your penultimate line from:

EliminateBlanks = arrResult

to:

EliminateBlanks = Application.Transpose(arrResult)

To enable to me enter the formula as just =EliminateBlanks (without the need to prefix it with TRANSPOSE in Excel).

The only remaining question I have is: is there any method of not having to select the required range in Excel when entering the formula?

In your example, you need to highlight D1:D9 before entering the formula, however, if possible, I would like for the user to just be in their required single cell to use the UDF. The reason being that the range they would need could be fairly large, and having to carefully select the exact number of cells required could lead to human error and issues etc.

I appreciate that I'm now pushing my luck and this may not be possible.

Thank you very much for your help and swift reply, the UDF you have provided works really well.

AP

 

[Jonmo1]

You could enter it like

=INDEX(EliminateBlanks($A$1:$C$3),ROWS($1:1))

 

[mikerickson]

You could introduce an optional Index argument that will return the Nth element.
And a formula like
=EliminateBlanks($A1:$C$3, Row(A1)) would not need to be array entered.

Function EliminateBlanks(aRange as Range, optional Index As Long) As Variant
    Dim arrResult() As String
    Dim oneCell as Range, Pointer As Long

    ReDim arrResult(1 to aRange.Cells.Count)

    For Each oneCell in aRange
        If oneCell.Text <> vbNullString Then
            Pointer = Pointer + 1
            arrResult(Pointer) = oneCell.Text
        End If
    Next oneCell

    If Index < 1 Then
        EliminateBlanks = arrResult(Index)
    Else
        EliminateBlanks = Application.Transpose(arrResult)
    End If
End Function

 

[RoryA]

The straightforward answer is no - you cannot enter a UDF into one cell and have it populate many others. (Well, you can, but it involves using Windows timers and is definitely not recommended.)

 

[AndyPandy27]

Hi All,

Many thanks for all your suggestions and feedback; it is all really useful as I am trying to learn more about VBA.

I'll use this information and determine the best bet moving forwards.

Thanks again for everyone's help, especially Mike for the UDF - greatly appreciated.

AP

 

[mikerickson]

You can make a UDF so that it will avoid the NA cells.
So you can put {=EliminateBlanks3($A:$C)} in D1:D1000

Function EliminateBlanks3(aRange as Range, optional Index As Long) As Variant
    Dim arrResult() As String
    Dim oneCell as Range, Pointer As Long

    Set aRange = Application.Intersect(aRange.Parent.UsedRange, aRange)

    ReDim arrResult(1 to aRange.Cells.Count)

    For Each oneCell in aRange
        If oneCell.Text <> vbNullString Then
            Pointer = Pointer + 1
            arrResult(Pointer) = oneCell.Text
        End If
    Next oneCell

    If Index < 1 Then
        EliminateBlanks3 = arrResult(Index)
    Else
        If Typename(Application.Caller) = "Range" Then
            ReDim Preserve arrResult(1 to Application.Caller.Cells.Count)
        End If
        EliminateBlanks3 = Application.Transpose(arrResult)
    End If
End Function