Reputation: 845

VBA optimizing code to run faster, user created function is way too slow

I have written the below function which basically VLOOKUPs all the results associated with the value being VLOOKUPd and stacks them in a list.

For example

if we VLOOKUP on value A the result should be 1, 2, 3, 4, 5, 6

A   1   1, 2, 3, 4, 5, 6
A   2   1, 2, 3, 4, 5, 6
A   3   1, 2, 3, 4, 5, 6
A   4   1, 2, 3, 4, 5, 6
A   5   1, 2, 3, 4, 5, 6
A   6   1, 2, 3, 4, 5, 6
B   7   N/A
B   8   N/A
B   9   N/A
B   0   N/A

But the function takes too much time to run on more than 50 rows of data, is there a way to make it run faster and hopefully not crash the Excel file?

Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)

    Dim r As Range
    Dim result As String

    result = ""

    For Each r In lookuprange

        If r = lookupval Then

            If result = "" Then

                result = result & " " & r.Offset(0, indexcol - 1)

            Else

                result = result & ", " & r.Offset(0, indexcol - 1)

            End If

        End If

    Next r

    MYVLOOKUP = result

End Function

Upvotes: 2

Answers (3)

user10735198

Reputation:

You haven't provided any information on how the UDF is deployed but I'll bet that is at least half of the problem.

I'm betting you are recreating that concatenated string for every duplicate in column A. Further, I reckon there is a pretty good chance you are using full column references.

I'm going to assume that your data starts in row 2.

The extent of the numbers in column B is,

b2:index(b:b, match(1e99, b:b))

The extent of the duplicated identifiers in column A is,

a2:index(a:a, match(1e99, b:b))

If you have already concatenated a result for the identifier in column A then it is a lot faster to retrieve that result from above then it is to build it again. Further, if you are looking above the current row to see if a result has already been processed and it hasn't been processed then there is no reason to include those rows in the current concatenation build.

In C2 use this formula and fill down to the extent of the values in columns A & B.

=iferror(index(c$1:C1, match(a2, a$1:a1, 0)), MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2))

If your data actually starts in row 1then usethis formula in C1.

=MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2)

Example:

Consider the above formula in C10. It looks for a match to A10 within A1:A9; if found, it returns the previously concatenated string from the associated row in column C. If not found, it builds a new concatenated string but only from the identifiers starting in row 10 from column A and the values starting with row 10 in column B down to the row containing the last number in column B.

Upvotes: 1

Darren Bartrup-Cook

Reputation: 19737

@JNevill just beat me to it, but wanted to post my code anyway. :)
This will work for a sorted list and return #N/A if lookupval isn't found.

Public Function MyVlookup(lookupval As Variant, lookuprange As Range, indexcol As Long) As Variant

    Dim rFound As Range
    Dim itmCount As Long
    Dim rReturns As Variant
    Dim itm As Variant
    Dim sReturn As String

    With lookuprange

        'After looks at the last cell in first column,
        'so first searched cell is first cell in column.
        Set rFound = .Columns(1).Find( _
            What:=lookupval, _
            After:=.Columns(1).Cells(.Columns(1).Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchDirection:=xlNext, _
            MatchCase:=True)

        If Not rFound Is Nothing Then

            itmCount = Application.WorksheetFunction.CountIf(lookuprange, lookupval)
            rReturns = rFound.Offset(, indexcol - 1).Resize(itmCount)

            For Each itm In rReturns
                sReturn = sReturn & itm & ","
            Next itm
            MyVlookup = Left(sReturn, Len(sReturn) - 1)

        Else
            MyVlookup = CVErr(xlErrNA)
        End If

    End With

End Function

Edit - almost works. =MyVlookup("A",$A6:$B$10,2) on the sample data returns #VALUE rather than 6.

Upvotes: 1

JNevill

Reputation: 50019

You could consider using the Find() method of the Range object like so:

Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long) As String
    Dim foundRange As Range
    Dim foundArr() As String: ReDim foundArr(0 To 0)
    Dim firstFoundAddress As String

    'perform the first find
    Set foundRange = lookuprange.Find(lookupval)

    'Capture address to avoid looping
    firstFoundAddress = foundRange.Address

    'Find values
    Do While Not foundRange Is Nothing
        'Bump the array if this isn't the first element
        If foundArr(0) <> "" Then ReDim Preserve foundArr(0 To UBound(foundArr) + 1)

        'Add to the array
        foundArr(UBound(foundArr)) = foundRange.Offset(, indexcol - 1).Value

        'Lookup next value
        Set foundRange = lookuprange.Find(What:=lookupval, After:=foundRange)

        'Exit if we looped
        If foundRange.Address = firstFoundAddress Then Exit Do
    Loop

    'join the results for output
    MYVLOOKUP = Join(foundArr, ",")
End Function

Find() is very quick to run and you won't have to iterate your entire search range.

Upvotes: 3

VBA optimizing code to run faster, user created function is way too slow

Answers (3)

Related Questions