type mismatch in vlookup - vba

Question

I am attempting to do the following:
Look at the first row's column B (Event) from entiresalespipeline
Match Column B to a table (Events_and_Activities) that links a date to each event
If that date is in the future, copy the entire row into the next empty row in a third worksheet (CurrentSalesPipeline)
Repeat this process until there are no more filled rows in the first spreadsheet.
I have created the following code, which when I mouse-over the text appears to give correct data, but which gives me the following error:
Run-time error '13': Type mismatch
Sub ShowUpcoming_Click()
Dim rCell As Range
Dim ws As Worksheet
Dim DateConf As Long
For Each rCell In Sheet1.Range("B3:B5000")
Set ws = Worksheets("CurrentSalesPipeline")
DateConf = Application.VLookup(rCell, Worksheets("Events_and_Activities").Range("A2:B12"), 2, False)
Range("A1").Value = DateConf
If CDate(DateConf) >= CDate((Date)) Then
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
.Cells(iRow, 1).Value = Worksheets("entiresalespipeline").Range("A3:A3").Value
.Cells(iRow, 2).Value = Worksheets("entiresalespipeline").Range("B3:B3").Value
.Cells(iRow, 3).Value = Worksheets("entiresalespipeline").Range("C3:C3").Value
.Cells(iRow, 4).Value = Worksheets("entiresalespipeline").Range("D3:D3").Value
.Cells(iRow, 5).Value = Worksheets("entiresalespipeline").Range("E3:E3").Value
.Cells(iRow, 6).Value = Worksheets("entiresalespipeline").Range("F3:F3").Value
.Cells(iRow, 7).Value = Worksheets("entiresalespipeline").Range("G3:G3").Value
.Cells(iRow, 8).Value = Worksheets("entiresalespipeline").Range("H3:H3").Value
.Cells(iRow, 9).Value = Worksheets("entiresalespipeline").Range("I3:I3").Value
.Cells(iRow, 10).Value = Worksheets("entiresalespipeline").Range("J3:J3").Value
.Cells(iRow, 11).Value = Worksheets("entiresalespipeline").Range("K3:K3").Value
.Cells(iRow, 12).Value = Worksheets("entiresalespipeline").Range("L3:L3").Value
.Cells(iRow, 13).Value = Worksheets("entiresalespipeline").Range("M3:M3").Value
.Cells(iRow, 14).Value = Worksheets("entiresalespipeline").Range("N3:N3").Value
.Cells(iRow, 15).Value = Worksheets("entiresalespipeline").Range("O3:O3").Value
.Cells(iRow, 16).Value = Worksheets("entiresalespipeline").Range("P3:P3").Value
.Cells(iRow, 17).Value = Worksheets("entiresalespipeline").Range("Q3:Q3").Value
.Cells(iRow, 18).Value = Worksheets("entiresalespipeline").Range("R3:R3").Value
.Cells(iRow, 19).Value = Worksheets("entiresalespipeline").Range("S3:S3").Value
.Cells(iRow, 20).Value = Worksheets("entiresalespipeline").Range("T3:T3").Value
End With
End If
Next rCell
End Sub

Answer 1

You're declaring DateConf as a Long:
Dim DateConf As Long
And then assigning it the result of the VLookup call:
DateConf = Application.VLookup(rCell, Worksheets("Events_and_Activities").Range("A2:B12"), 2, False)
That's a lot of assumptions to make: you're relying on VBA to perform an implicit conversion of the returned value to a Long, without knowing if the returned value will be a valid numeric.
What if the VLookup returns an empty string? What if it returned an #N/A error value?
Dim lookupResult As Variant
lookupResult = Application.VLookup(rCell, Worksheets("Events_and_Activities").Range("A2:B12"), 2, False)
If IsNumeric(lookupResult) Then
DateConf = CLng(lookupResult)
...
End If
Reduce the number of assumptions you're making, you'll reduce the number of potential issues by as much.

Answer 2

Thank you everyone for your very thoughtful and extremely helpful input!
After some tinkering, I managed to come up with the following, which does everything I need it to do.
Mat's Mug - your suggestion was perfect!
Tim Williams - I tried your single line solution to the copy/pasting, but it only copied the first line (headings) over every line in the range, so I stuck with what I had.
Sub ShowUpcoming_Click()
Dim lastrow As Long
Dim ws As Worksheet
Dim DateConf As Long
Dim r As Long
Set ws = Worksheets("CurrentSalesPipeline")
Dim lookupresult As Variant
'find last completed row of entire spreadsheet
lastrow = Worksheets("EntireSalesPipeline").Range("B" & Rows.Count).End(xlUp).Row
'From the first completed line (row 3) to last completed row
For r = 3 To lastrow
'lookup conference date from events/activities spreadsheet
lookupresult = Application.VLookup(Worksheets("EntireSalesPipeline").Cells(r, 2).Value, Worksheets("Events_and_activities").Range("A2:B13"), 2, False)
If IsNumeric(lookupresult) Then
DateConf = CLng(lookupresult)
End If
'If vlookup finds a date, then check to make sure it is in the future from when the button was hit.
If CDate(DateConf) >= CDate((Date)) Then
'If it is a future event, then copy that data into the current spreadsheet
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
.Cells(iRow, 1).Value = Worksheets("entiresalespipeline").Cells(r, 1).Value
.Cells(iRow, 2).Value = Worksheets("entiresalespipeline").Cells(r, 2).Value
.Cells(iRow, 3).Value = Worksheets("entiresalespipeline").Cells(r, 3).Value
.Cells(iRow, 4).Value = Worksheets("entiresalespipeline").Cells(r, 4).Value
.Cells(iRow, 5).Value = Worksheets("entiresalespipeline").Cells(r, 5).Value
.Cells(iRow, 6).Value = Worksheets("entiresalespipeline").Cells(r, 6).Value
.Cells(iRow, 7).Value = Worksheets("entiresalespipeline").Cells(r, 7).Value
.Cells(iRow, 8).Value = Worksheets("entiresalespipeline").Cells(r, 8).Value
.Cells(iRow, 9).Value = Worksheets("entiresalespipeline").Cells(r, 9).Value
.Cells(iRow, 10).Value = Worksheets("entiresalespipeline").Cells(r, 10).Value
.Cells(iRow, 11).Value = Worksheets("entiresalespipeline").Cells(r, 11).Value
.Cells(iRow, 12).Value = Worksheets("entiresalespipeline").Cells(r, 12).Value
.Cells(iRow, 13).Value = Worksheets("entiresalespipeline").Cells(r, 13).Value
.Cells(iRow, 14).Value = Worksheets("entiresalespipeline").Cells(r, 14).Value
.Cells(iRow, 15).Value = Worksheets("entiresalespipeline").Cells(r, 15).Value
.Cells(iRow, 16).Value = Worksheets("entiresalespipeline").Cells(r, 16).Value
.Cells(iRow, 17).Value = Worksheets("entiresalespipeline").Cells(r, 17).Value
.Cells(iRow, 18).Value = Worksheets("entiresalespipeline").Cells(r, 18).Value
.Cells(iRow, 19).Value = Worksheets("entiresalespipeline").Cells(r, 19).Value
.Cells(iRow, 20).Value = Worksheets("entiresalespipeline").Cells(r, 20).Value
End With
End If
'Repeat for next line in existing
Next r
End Sub
This is a great community. Thank you again!
Sarah