VLookUp Error

[BenChod]

Hi All -

I have a vlookup running and when a match is not found, the code crashes. The error is: Run-time error '1004' Unable to get the Vlookup property of the worksheetfunction class. This only happens where there is no match. If there is no match, it is suppose to go to the line code where this is no match and enter no match. Hoping someone can take a quick look and see what the issue is. I already set all the variable so they are not copied below.


Set QC = Sheets("BlockList")
Set RefDat = Sheets("QC")
Set WSF = Application.WorksheetFunction

With QC
Set AssToApp = .Columns(4) 'Assigned to App'
Set Status = .Columns(5)
Set Severity = .Columns(6)
Set Blocking = .Columns(7)
Set FixDate = .Columns(8)

'Use last non empty column plus 1
Set TestCol = .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).EntireColumn

'Use bottom non empty cell in "C"
Set QCTable = QC.Range(.Cells(2, "C"), .Cells(Rows.Count, "C").End(xlUp))
End With 'QC

With RefDat
'Use bottom non empty cell in "A:M"
Set RefTable = .Range(.Cells(2, "A"), .Cells(Rows.Count, "M").End(xlUp))
End With 'RefDat

For Each Cel In QCTable
On Error GoTo NotFound
AssToApp.Cells(Cel.Row) = WSF.VLookUp(Cel, RefTable, 2, False)
Status.Cells(Cel.Row) = WSF.VLookUp(Cel, RefTable, 4, False)
Severity.Cells(Cel.Row) = WSF.VLookUp(Cel, RefTable, 5, False)
Blocking.Cells(Cel.Row) = WSF.VLookUp(Cel, RefTable, 6, False)
FixDate.Cells(Cel.Row) = WSF.VLookUp(Cel, RefTable, 13, False)

GoTo Continue 'No errors

NotFound:
Status.Cells(Cel.Row) = "Not Found"
On Error GoTo 0 'Resets error handling
Continue:
Next Cel

'MsgBox "Done"
End Sub

[mdmackillop]

If you post a sample it's easier to test a solution

[snb]

If you use VBA don't use excelfunctions like vlookup.
If you use VBA use arrays instead of ranges, rows, columns, cells.

[BenChod]

Please see attached

19489

[mdmackillop]

Try this

With RefDat
'Use bottom non empty cell in "A:M"
Set reftable = .Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp))
Set reftable = reftable.Resize(, 13)

End With 'RefDat

For Each cel In QCTable
Application.Goto cel
Set c = reftable.Columns(3).Find(cel)
If c Is Nothing Then
Status.Cells(cel.Row) = "Not Found"
Else
AssToApp.Cells(cel.Row) = c.Offset(, 1)
Status.Cells(cel.Row) = c.Offset(, 3)
Severity.Cells(cel.Row) = c.Offset(, 4)
Blocking.Cells(cel.Row) = c.Offset(, 5)
FixDate.Cells(cel.Row) = c.Offset(, 13)
End If
Next cel
End Sub

[snb]

This is what I mean:


Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Resize(, 6)

sp = Sheet31.Cells(1).CurrentRegion.Resize(, 13)
For j = 2 To UBound(sn)
For jj = 2 To UBound(sp)
If sn(j, 1) = sp(jj, 1) Then Exit For
Next
If jj <= UBound(sp) Then
For jjj = 2 To UBound(sn, 2)
sn(j, jjj) = sp(jj, Choose(jjj, 0, 2, 4, 6, 8, 13))
Next
End If
Next

Sheet1.Cells(1).CurrentRegion.Resize(, 6) = sn
End Sub

[BenChod]

Thank you again for your help. Your recommended approach worked. I do have one question: Is there any way to speed the look up? When I run the code, I can see the code going through each row and populating the data. If I have several thousand rows of data, this will take some time to complete is my assumption.

Thanks again for your help.

[snb]

see #6

[Paul_Hossler]

Since it looks like a lot of duplicated IDs, a collection might be faster




Option Explicit

Sub PH_1()
Dim collQC As Collection
Dim rQC As Range, rQCID As Range
Dim rBlock As Range, rBlockID As Range, rQCRow As Range
Dim i As Long

Application.ScreenUpdating = False

Set collQC = New Collection

Set rQC = Worksheets("QC").Cells(1, 1).CurrentRegion
With rQC
For i = 2 To .Rows.Count
If Len(.Cells(i, 1).Value) > 0 Then
On Error Resume Next
collQC.Add .Cells(i, 1).EntireRow, CStr(.Cells(i, 1).Value)
On Error GoTo 0
End If
Next I
End With


Set rBlock = Worksheets("BlockList").Cells(1, 1).CurrentRegion
With rBlock
For i = 2 To .Rows.Count
Set rQCRow = Nothing
On Error Resume Next
Set rQCRow = collQC(CStr(.Cells(i, 1).Value))
On Error GoTo 0

If Not rQCRow Is Nothing Then
.Cells(i, 2).Value = rQCRow.Cells(1, 2).Value
.Cells(i, 3).Value = rQCRow.Cells(1, 4).Value
.Cells(i, 4).Value = rQCRow.Cells(1, 5).Value
.Cells(i, 5).Value = rQCRow.Cells(1, 6).Value
.Cells(i, 6).Value = rQCRow.Cells(1, 31).Value
End If

Next I
End With

Application.ScreenUpdating = True
End Sub

[BenChod]

Paul: Thank and it worked quite well.