VBA：VLookUp多重结果

Question

I require a little help with some code.

I am trying to perform a VLookup, and has the data displayed in columns O, P and Q.

What i am trying to do is loop though sheet("Global") column A starting at row 3 until last used row. It needs to match data in sheet("Details") in column A starting at row 2.

So when it finds a matching value, it will display the results from "Details" C2 in "Global" O2, "Details" I2 in "Global" P2 and "Details" G2 in "Global" Q2.

It then needs to loop though "Global" matching and copying all data. If no match is found the display "NA!".

The last thing I need it to do is to delete all rows in Global where a match was not found.

The code I have below does what I need, the only problem is that it is incredibly slow, taking minutes to loop though 800 rows, sometimes even longer!!

Is there another way to do this, that will run smoother and faster?

Any help is appreciated!!

Thank You

`Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long

' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row

' loop over values in "Global"
For i = 3 To lastG
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find

    ' loop over values in "details"
    For j = 2 To lastD
        currVal = Sheets("Details").Cells(j, "A")

        If lookupVal = currVal Then
            Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
            Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
            Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
            ' mark the row
            Sheets("Details").Cells(j, "Z") = "marked"

        End If
    Next j
Next i

' loop over rows in "details" and delete rows which have not been marked
For j = 2 To lastD
    If Sheets("Details").Cells(j, "Z") <> "marked" Then
        ' delete unmarked rows
        Sheets("Details").Cells(j, "A").EntireRow.Delete
        If Sheets("Details").Cells(j, "B") <> "" Then
            j = j - 1 ' revert iterator so it doesn't skip rows
        End If
    Else:
        ' remove the mark
        Sheets("Details").Cells(j, "Z") = ""
    End If
Next j
End Sub`

Answer 1

With the advice on here, and a lot of trial and error, i have managed to tweak my code.

I tested this on over 600 records and it runs in seconds, where it would have taken minutes on the previous code.

If you can see a better way of doing the below code, then let me know, i'm still learning VBA so all the help I can get the better!!!

Thanks for all the support!!!!!!!!

Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .CutCopyMode = False
End With
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row

' loop over values in "Global"
For i = 2 To lastG
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find

    ' loop over values in "details"
    For j = 2 To lastD
        currVal = Sheets("Details").Cells(j, "A")

        If lookupVal = currVal Then
            Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
            Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
            Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
            ' mark the row
            Sheets("Details").Cells(j, "Z") = "marked"
            Sheets("Details").Cells(1, "Z") = "marked"
        Exit For
        End If
    Next j
Next i

On Error Resume Next
Sheets("Details").Columns("Z").SpecialCells(xlBlanks).EntireRow.Delete
Sheets("Details").Columns("Z").ClearContents

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .CutCopyMode = True
End With

End Sub

Answer 2

Your code is very inefficient as written, which is why it takes forever. You didn't mention specifically how many rows are in your "Global" and "Detail" sheets (you mentioned 800, not sure if this is both). But if there were 1000 in each, your two loops are 1000x1000 = 1 million cycles.

The best solution is not to use VBA at all, but use the VLOOKUP function in Excel. Here's what you need to do:

Sort the Details sheet by Column A Then, in the Global sheet, in cell O3, you'll put the following formula: =VLOOKUP(A3,Details!$A2:$I(whatever the last row is),3,FALSE)

In case you're not familiar with this function, it takes the first argument, looks it up in the first column of the second argument until it finds a match, and then returns the value in that row at the column of the third argument. The last "FALSE" gives you only an exact match, else you'll get an #NA (if you use TRUE, you'll get the closest match instead).

Then copy this formula down the entire sheet.

Then copy the column, and paste values. This gets rid of the forumlas and just leaves the values, which makes everything much faster.

Then sort the table by this column, and all of the #NA will fall together, and you can delete the whole thing in one operation.

If you want to do this via VBA, the steps above can easily be coded:

Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
Dim DetailsTable as Range

' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row

' Make sure this is sorted.  If not, you'll need to add a sort command
Set DetailsTable=Sheets("Details").Range(Sheets("Details").Cells(1, 2), Sheets.Cells(lastD, 9))

Sheets("Global").Range("O3")="=VLOOKUP(A3," & DetailsTable.address(external:=true) & "3,FALSE)"
Sheets("Global").Range("O3").copy destination:=Sheets("Global").Range( Sheets("Global").cells(3,"O"),Sheets("Global").cells(lastG,"O"))

End Sub

This is a start, but should get you going. Good luck!

Answer 3

There are a couple things that you could do to easily speed up your code.

First off, if you add the line Application.ScreenUpdating = False at the beginning of your code, it will stop Excel from having to do all of the flickers and flashes that you see while executing your code (which is actually adding in those values one by one, deleting rows, etc. all which take a lot of time).

Next, you can add an Exit For at the end of your If statement (right before your End If ). This will stop the nested For Loop to prevent running through all of the data when you've already found what you're looking for.

Lastly, I know that you use j = j - 1 to set your iterator to not skip over rows, but a better practice is to instead work the opposite direction. If you change the For Loop to read For j = lastD to 2 Step -1 it will make the Loop run in reverse, so deleted rows aren't an issue and you can remove the "reset" line (this will only barely speed up your code, it's just more of a suggestion of how to deal with this common problem).