VBA UDF Return Array

Question

I have the following UDF which needs to loop through all the data on the sheet called Classes and return the names of the students and the class names (columns A and B) if the students name is displayed in a list on the sheet called Timetable (this list is in cells BM3 to BM21) and the class takes place on the day and time entered in the UDF. Currently it returns a #Value error. What have I done wrong?

Function TTDisplay(Day As String, Time As Variant) As Variant

Dim Result(1 To 12) As String
Dim Students As String
Dim cell As Integer
Dim LastRow As Long
Dim Classes As Worksheet
Dim Timetable As Worksheet
Dim x As Integer
Dim TimeSpan As Integer
Dim TTTime As Integer

Classes = Sheets("Classes")
Timetable = Sheets("Timetable")
LastRow = Classes.Cells(Classes.Rows.count, "A").End(xlUp).Row
TTTime = TMins(Time)

For cell = 3 To 21
Students = Students & Timetable.Cells(cell, 65).value & "!"
Next cell

x = 1
For cell = 2 To LastRow

        If InStr(Students, Classes.Cells(cell, 2)) Then
            If Day = Classes.Cells(cell, 9) Then
                If Time = Classes.Cells(cell, 12) Then
                Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                x = x + 1
                Else
                TimeSpan = TMins(Classes.Cells(cell, 12)) + 30
                    Do While TimeSpan < TMins(Classes.Cells(cell, 11))
                        If TimeSpan = TTTime Then
                        Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                        x = x + 1
                        GoTo MoveOn
                        Else
                        TimeSpan = TimeSpan + 30
                        End If
                    Loop
MoveOn:
                End If
            End If
        End If

Next cell
TTDisplay = Result(1)
End Function

as Result is 1 to 12, are you sure there are no more than 12 entries? Directly after For cell = 2 To LastRow put in If x = 13 Then Exit For and check again... or better, run the code line by line... — Dirk Reichel
– Dirk Reichel, Commented Jul 19, 2016 at 6:54

gizlmo · Accepted Answer · 2016-07-19 07:48:34Z

3

If you want to return an array, you can define the function as Variant, but preferably change your function head to this (makes it easier to directly see return-type of the function):

Function TTDisplay(Day As String, Time As Variant) As String()

On the last line (TTDisplay = Result(1)) you are only returning one value, so change it to return the whole array: TTDisplay = Result

edited Jul 19, 2016 at 7:48

answered Jul 19, 2016 at 6:38

gizlmo

1,9221 gold badge16 silver badges14 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

user6432984 · Accepted Answer · 2016-07-19 07:03:29Z

TTDisplay = Result(1) is setting the value of your UDF to the first element in the array. TTDisplay = Result will return the full array.
You'll also have to enter you formula as an array formula using ctrl+shift+enter {=TTDisplay($A2,$B2)}.

I modified your code making the array dynamic.

Function TTDisplay(Day As String, Time As Variant) As Variant

    Dim Result() As String
    Dim Students As String
    Dim cell As Integer
    Dim LastRow As Long
    Dim Classes As Worksheet
    Dim Timetable As Worksheet
    Dim x As Integer
    Dim TimeSpan As Integer
    Dim TTTime As Integer

    Classes = Sheets("Classes")
    Timetable = Sheets("Timetable")
    LastRow = Classes.Cells(Classes.Rows.Count, "A").End(xlUp).Row
    TTTime = TMins(Time)

    For cell = 3 To 21
        Students = Students & Timetable.Cells(cell, 65).Value & "!"
    Next cell

    x = 0
    ReDim Result(x)

    For cell = 2 To LastRow

        If InStr(Students, Classes.Cells(cell, 2)) Then
            If Day = Classes.Cells(cell, 9) Then
                If Time = Classes.Cells(cell, 12) Then
                    ReDim Preserve Result(x)
                    Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                    x = x + 1
                Else
                    TimeSpan = TMins(Classes.Cells(cell, 12)) + 30
                    Do While TimeSpan < TMins(Classes.Cells(cell, 11))
                        If TimeSpan = TTTime Then
                            ReDim Preserve Result(x)
                            Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                            x = x + 1
                            GoTo MoveOn
                        Else
                            TimeSpan = TimeSpan + 30
                        End If
                    Loop
MoveOn:
                End If
            End If
        End If

    Next cell
    TTDisplay = Result
End Function

Collectives™ on Stack Overflow

VBA UDF Return Array

2 Answers 2

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related