Hi

I'm using UDF MLOOKUP form
http://www.excelfox.com/forum/f12/vl...iple-values-4/
Basically this is the the same function as lookup, but it returns multiple results in one cell.

I have 2 sheets, where MLOOKUP is used multiple times to construct the reports. But it takes too much time and I had to turn off AutoCalculation on these sheets as the whole Workbook becomes very laggy. An when I turn it on again, it could take more than minute to calculate the results. As my database will become tens of times larger, I am thinking of ways to optimise it.

Could you please advice me other approaches.

Many thanks.


P.S. Here is the code of this UDF.
Public Function MLOOKUP(TableArray As Range, ByVal LookupVal, LookupRange As Range, _
                                    Optional ByVal NumAsText As Boolean = False, _
                                    Optional ByVal NthMatch As Long, _
                                    Optional IgnoreBlanks As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure : MLOOKUP
' Author    : Krishnakumar @ ExcelFox.com
' Date      : 12/5/2012
' Purpose   : Returns multiple values
' Amended   : Include option to ignore blanks - 07/22/13
'---------------------------------------------------------------------------------------
If Not TypeOf TableArray Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If Not TypeOf LookupRange Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Rows.Count <> LookupRange.Rows.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Columns.Count <> LookupRange.Columns.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If

Dim LV_Cnt      As Long 'Count Loookup Value
Dim KA1, KA2
Dim r As Long, c As Long
Dim fFoundNo    As Long
Dim n           As Long
Dim strLval     As String

If IsNumeric(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & LookupVal & ")")
    If NumAsText Then GoTo 1
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
ElseIf IsDate(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & CLng(LookupVal) & ")")
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
Else
1:
    strLval = """" & LookupVal & """"
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & strLval & ")")
    fFoundNo = Evaluate("match(" & strLval & "," & LookupRange.Address(, , , 1) & ",0)")
End If

If NthMatch > 0 Then
    If LV_Cnt = 0 Or NthMatch > LV_Cnt Then
        MLOOKUP = CVErr(2042)
        Exit Function
    End If
End If


KA1 = TableArray: KA2 = LookupRange

For r = fFoundNo To UBound(KA1, 1)
    For c = 1 To UBound(KA1, 2)
        If LCase$(KA2(r, c)) = LCase$(LookupVal) Then
            If NthMatch Then
                n = n + 1
                If n = NthMatch Then
                    MLOOKUP = KA1(r, c)
                    Exit Function
                End If
            Else
                If Not IgnoreBlanks Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                ElseIf Len(KA1(r, c)) Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                End If
            End If
        End If
    Next
Next
MLOOKUP = Mid$(MLOOKUP, 2)
End Function