Excel VBA Vlookup multiple Columns

Question

i need make this macro more effective and faster. My solution is very, very slow. There can be over 100k rows

Sub VlookupPOR()


Dim PorWs As Worksheet, InDataBodyWs As Worksheet
Dim PorLastRow As Long, InDataBodyLastRow As Long, x As Long
Dim dataRng As Range


Set PorWs = ThisWorkbook.Worksheets("POR")
Set InDataBodyWs = ThisWorkbook.Worksheets("InDataBody")


PorLastRow = PorWs.Range("A" & Rows.Count).End(xlUp).Row
InDataBodyLastRow = InDataBodyWs.Range("H" & Rows.Count).End(xlUp).Row


Set dataRng = InDataBodyWs.Range("H4:AR" & InDataBodyLastRow)


For x = 2 To PorLastRow

    On Error Resume Next
    PorWs.Range("L" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 5, False) 'LastName
    
    PorWs.Range("N" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 7, False) 'FirstName
    
    PorWs.Range("O" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 2, False) 'BirthNumber

    PorWs.Range("K" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 4, False) 'NativeLastName

    PorWs.Range("J" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 16, False) 'legalPersonName
    
    PorWs.Range("H" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 18, False) 'legalPersonBusinessId
    
    PorWs.Range("I" & x).Value = Application.WorksheetFunction.VLookup( _
    PorWs.Range("G" & x).Value, dataRng, 24, False) 'legalPersonBusinessId
    
    
Next x


End Sub

I need a vlookup for multiple columns from two sheets. I have only one identifier for everything and I need to add data from another sheet.

Can you help me?

Can you share an example of your columns? Depending on your data, you could create a 'hash value': For examples you have two colums( "first_name" and "second_name"). You want to look up a person by FULL name, so create a dummy column (it can be hidden) called "full_name" where the value is set to =first_name&" "&second_name. — Donald Koscheka
– Donald Koscheka, Commented May 11, 2022 at 14:33
@findwindow the moment I put it on all cells, I get an excel over 1GB and unfortunately I have to use excel to make it universally workable — Jakub
– Jakub, Commented May 11, 2022 at 14:37
@DonaldKoscheka I have a unique identifier in both sheets I have a certain ID for the person , I just need to add name, surname, birth number, document number etc to the second sheet based on that ID. In total about 13 values x 100,000 rows , so a lot of data and my solution is totally useless — Jakub
– Jakub, Commented May 11, 2022 at 14:50
@findwindow I understand you. unfortunately this is not possible. i have one , TXT file where i have to separate the personal data and the other data. The other data is passed to a third party for processing (the third party must not have access to the personal data) and transformed into a new modified TXT file and then the personal data must be added back to the new one. This is the banking sector and they are very strict here, so despite all reservations they are looking for a way in excel — Jakub
– Jakub, Commented May 11, 2022 at 18:57
Hm. Maybe try dividing the new file into multiple workbooks of 1000 rows each and doing vlookup. Then combine the values of all workbooks? — findwindow
– findwindow, Commented May 11, 2022 at 19:04

VBasic2008 · Accepted Answer · 2022-05-11 16:08:11Z

1

VBA Lookup Using Application.Match

This is only a step faster.
You were looking up seven times instead of once per row.
With Application.Match you get the row index (or an error if no match) and then read all the necessary cells from this row (sIndex).

A Quick Fix

Sub LookupPOR()
    
    ' Source
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("InDataBody")
    Dim slRow As Long: slRow = sws.Range("H" & sws.Rows.Count).End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range("H4:AR" & slRow)
    Dim scrg As Range: Set scrg = srg.Columns(1)
    
    ' Destination
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("POR")
    Dim dlRow As Long: dlRow = dws.Range("A" & dws.Rows.Count).End(xlUp).Row
    
    Dim dValue As Variant
    Dim sIndex As Variant
    Dim r As Long
    
    For r = 2 To dlRow
        dValue = dws.Cells(r, "G").Value
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then
                sIndex = Application.Match(dValue, scrg, 0)
                If IsNumeric(sIndex) Then
                    ' legalPersonBusinessId - "Y"
                    dws.Cells(r, "H").Value = srg.Cells(sIndex, 18).Value
                    ' legalPersonBusinessId - "AE"
                    dws.Cells(r, "I").Value = srg.Cells(sIndex, 24).Value
                    ' legalPersonName - "W"
                    dws.Cells(r, "J").Value = srg.Cells(sIndex, 16).Value
                    ' NativeLastName - "K"
                    dws.Cells(r, "K").Value = srg.Cells(sIndex, 4).Value
                    ' LastName - "L"
                    dws.Cells(r, "L").Value = srg.Cells(sIndex, 5).Value
                    ' FirstName - "N"
                    dws.Cells(r, "N").Value = srg.Cells(sIndex, 7).Value
                    ' BirthNumber - "I"
                    dws.Cells(r, "O").Value = srg.Cells(sIndex, 2).Value
                End If
            End If
        End If
    Next r
 
    MsgBox "Lookup complete.", vbInformation

End Sub

answered May 11, 2022 at 16:08

VBasic2008

56.8k5 gold badges21 silver badges38 bronze badges

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

3 Comments

Jakub Over a year ago

Thanks, it's a bit faster but still not enough to be user friendly with that amount of data. Hopefully they'll listen to me and let me develop it in something else :D

VBasic2008 Over a year ago

Would you kindly share what you mean by "it's a bit faster" in seconds or minutes?

Jakub Over a year ago

I didn't let the macro finish, either way. I've tested it now and after 10 minutes the old command has finished 120 records and the new 150 acceleration is there but when I imagine so is letting it run overnight. But it won't get past the bank's security

Collectives™ on Stack Overflow

Excel VBA Vlookup multiple Columns

1 Answer 1

VBA Lookup Using Application.Match

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

VBA Lookup Using Application.Match

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related