1

I’ve been experimenting with arrays to find a faster alternative to VLOOKUP(), which can take a long time to execute with very large data sets.

I searched SO and many other sites, grabbing snippets of code.

The data:

  • A1:A5 the list of values to lookup (1,2,3,4,5)
  • C1:C5 the range to ‘find’ the values (2,4,6,8,10)
  • D1:D5 the range of values to ‘return’ (a,b,c,d,e)

enter image description here

B1:B5 is where I’d like to paste the ‘looked-up’ values.

The code works up to a point, in that it does return correct values for the ‘looked-up’ value’s position in C1:C5 – and the correct values in the adjacent cells in D1:D5.

When I try to load the returned values to Arr4 (the array to be pasted back to the sheet) which is saying <Type mismatch> when I hover the mouse over it. It doesn’t stop the code from executing, but it doesn’t paste anything.

My questions are:

  1. How do I populate the array Arr4 with the myVal2 values, and
  2. How do I paste it back to the sheet?
Option Explicit
Sub testArray()
    Dim ArrLookupValues As Variant
    ArrLookupValues = Sheet1.Range("A1:A5")    'The Lookup Values
        
    Dim ArrLookupRange As Variant
    ArrLookupRange = Sheet1.Range("C1:C5")    'The Range to find the Value
        
    Dim ArrReturnValues As Variant
    ArrReturnValues = Sheet1.Range("D1:D5")    'The adjacent Range to return the Lookup Value
    
    Dim ArrOutput As Variant 'output array
        
    Dim UpperElement As Long
    UpperElement = UBound(ArrLookupValues)     'Used purely for the ReDim statement
        
    Dim i As Long
    For i = LBound(ArrLookupValues) To UBound(ArrLookupValues)
        Dim myVal As Variant
        myVal = ArrLookupValues(i, 1)
            
        Dim pos As Variant 'variant becaus it can return an error
        pos = Application.Match(myVal, ArrLookupRange, 0) 'pos always returns the correct position
            
        Dim myVal2 As Variant
        If Not IsError(pos) Then
            myVal2 = ArrReturnValues(pos, 1)           'myVal2 always returns the correct value
            ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
            ArrOutput(i, 1) = myVal2
        Else
            ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
            myVal2 = "Not Found"
            ArrOutput(i, 1) = myVal2
        End If
    Next i
        
    Dim Destination As Range
    Set Destination = Range("B1")
    Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = 

    ArrOutput
End Sub
Improve this question
4
  • First of all you need to remove On Error Resume Next. This line hides all error massages but the errors still occur, you just cannot see their messages. So if you don't see the errors you cannot fix them and if you don't fix them it cannot work. Commented Nov 9, 2020 at 9:00
  • @PEH thank you for your prompt response. I agree with what you say, however, when I removed that line, the code stopped execution at the very next line if it didn't find a value that matched. Commented Nov 9, 2020 at 9:05
  • 1
    well then use proper error handling and an If statement there: If Not IsError(pos) Then and put myVal2 = Arr3(pos, 1) and the rest within. Never use On Error Resume Next like you did. Commented Nov 9, 2020 at 9:08
  • Also your Arr4 needs to be 2 dimensional like your other arrays. Even if it is only one column it needs no be Arr4(1 To UpperElement, 1 To 1) and Arr4(i, 1) = myVal2 Commented Nov 9, 2020 at 9:11

3 Answers 3

Reset to default
3

According to @T.M 's answer, you can even do that without looping just by using VLookup instead of Match:

Public Sub testArraya()
    With Sheet1
        Dim ArrLookupValues() As Variant
        ArrLookupValues = .Range("A1:A5").Value        ' lookup values        1,2,3,4,5,6
    
        Dim ArrLookupReturnRange() As Variant          ' lookup range items   2,4,6,8,10
        ArrLookupReturnRange = .Range("C1:D5").Value   ' And return column D  a,b,c,d,e
    End With
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '[1] Match all values at once and return other values of column D
    '    (found position indices or Error 2042 if not found)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim ArrOutput() As Variant
    ArrOutput = Application.VLookup(ArrLookupValues, ArrLookupReturnRange, 2, 0)
    
    '[3] write results to any wanted target
    Dim Destination As Range
    Set Destination = Sheet1.Range("B1")         ' ‹‹ change to your needs
    Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput     
End Sub

Or even extremly shortened and almost a one liner:

Public Sub testArrayShort()
    Const nRows As Long = 5 'amount of rows
    
    With Sheet1
        .Range("B1").Resize(nRows).Value = Application.VLookup(.Range("A1").Resize(nRows).Value, .Range("C1:D1").Resize(nRows).Value, 2, 0)
    End With
End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

2

  • Use proper error handling and an If statement instead of On Error Resume Next.

  • Also your Arr4 needs to be 2 dimensional like your other arrays. Even if it is only one column it needs no be Arr4(1 To UpperElement, 1 To 1) and Arr4(i, 1) = myVal2. Ranges are always 2 dimensional (row, column) even if there is only one column.

And I highly recommend to rename your array variables. When ever you feel like you have to give your variable numbers, you can be sure you are doing it wrong.

Rename them like following for example:

  • Arr1 --› ArrLookupValues
  • Arr2 --› ArrLookupRange
  • Arr3 --› ArrReturnValues
  • Arr4 --› ArrOutput

This is only a simple modification but your code will extremely gain in human readability and maintainability. You even don't need comments to describe the arrays because their names are self descriptive now.

Finally your output array can be declared the same size as the input arrays. Using ReDim Preserve makes your code slow, so avoid using it.

So something like this should work:

Option Explicit

Public Sub testArray()
    Dim ArrLookupValues() As Variant
    ArrLookupValues = Sheet1.Range("A1:A5").Value
    
    Dim ArrLookupRange() As Variant
    ArrLookupRange = Sheet1.Range("C1:C5").Value
    
    Dim ArrReturnValues() As Variant
    ArrReturnValues = Sheet1.Range("D1:D5").Value

    Dim UpperElement As Long
    UpperElement = UBound(ArrLookupValues, 1)   
    
    'create an empty array (same row count as ArrLookupValues)
    ReDim ArrOutput(1 To UpperElement, 1 To 1)
    
    Dim i As Long
    For i = LBound(ArrLookupValues, 1) To UBound(ArrLookupValues, 1)
        Dim FoundAt As Variant 'variant because it can return an error
        FoundAt = Application.Match(ArrLookupValues(i, 1), ArrLookupRange, 0) 'pos always returns the correct position

        If Not IsError(FoundAt) Then
            ArrOutput(i, 1) = ArrReturnValues(FoundAt, 1)
        Else
            ArrOutput(i, 1) = "Not Found"
        End If
    Next i
    
    Dim Destination As Range
    Set Destination = Range("B1") 'make sure to specify a sheet for that range!
    Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
End Sub
Improve this answer

10 Comments

@kevin9999 check my latest edit. I have made some changes. This should work.
@kevin9999: There is no Preserve in the posted code. Just remove it.
@PEH - Brilliant! Thank you so much, I have learnt so much more about arrays because of your efforts.
@kevin9999 it should not be there. It is without Preserve because we create an empty array so there is no data to preserve. The ReDim here in ReDim ArrOutput(1 To UpperElement, 1 To 1) is just no Dim like the others because its size is declared dynamically using the variable UpperElement which is not allowed with Dim.
If you declare a variant as Dim ArrOutput As Variant and use Preserve, the error will occur. If you use Dim ArrOutput() As Variant there will be no error, but it's pointless. It was needed in your initial code, when you were resizing the 1D array in the loop. Note that you can only resize the last dimension of an array. So you cannot resize the first dimension, rows, in a 2D array. You can resize just the columns (2nd dimension).
|
2

Just for fun a slight modification of @PEH 's valid approach demonstrating a rather unknown way to excecute a single Match checking both arrays instead of repeated matches:

Public Sub testArray()
    With Sheet1
        Dim ArrLookupValues As Variant
        ArrLookupValues = .Range("A1:A5").Value             ' lookup values      1,2,3,4,5,6
    
        Dim ArrLookupRange As Variant                       ' lookup range items 2,4,6,8,10
        ArrLookupRange = .Range("C1:C5").Value
    
        Dim ArrReturnValues As Variant                      ' return column D    a,b,c,d,e
        ArrReturnValues = .Range("D1:D5").Value
    End With
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '[1] Match all item indices within ArrLookupRange at once 
    '    (found position indices or Error 2042 if not found)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim ArrOutput
    ArrOutput = Application.Match(ArrLookupValues, ArrLookupRange, 0)
    
    '[2] change indices by return values
    Dim i As Long
    For i = 1 To UBound(ArrOutput)
        If Not IsError(ArrOutput(i, 1)) Then
            ArrOutput(i, 1) = ArrReturnValues(ArrOutput(i, 1), 1)
'        Else
'            ArrOutput(i, 1) = "Not Found"       ' optional Not Found statement instead of #NV
        End If
    Next i

    '[3] write results to any wanted target
    Dim Destination As Range
    Set Destination = Sheet1.Range("B1")         '<< change to your needs
    Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
End Sub
Improve this answer

4 Comments

Nice, I didn't know you could match full arrays rather than only single valies against a range. +1 That should be even faster.
Actually you can even omit the loop if using VLookup with this method. See my second answer.
Seems you beated me with it; I'm using MS Office 365, don't know if there are any version limitations to it rewriting the whole data set back. @PEH
I'm using Office Professional 2019 and it works as posted including writing it back.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.