Help with Copy based on dates code!

[harteorama]

Hi all,

Can anybody please help, i have the code below that copies information
from a worksheet called 'Vehicles' to another sheet called 'Section
4' (from cell. It uses two dates on a worksheet called 'Title
Page' (cells B19 (Start dates) & 20 (Finish Date)).

The problem is that i get an error when there are no dates on the
vehicle sheet match the date range on the title page, anybody know how
i can ingore/remove this error?

Sub GetData_Vehicle_Install()

Application.ScreenUpdating = False

Dim sDate As Date, fDate As Date
Dim WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Worksheets("Vehicles") '<== Change as required
Set WS2 = Worksheets("Section 4") '<== Change as required

WS1.Activate

With WS1
'assumes dates are in colum O
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

sDate = Sheets("Title Page").Range("b19")
fDate = Sheets("Title Page").Range("b20")

Set dateRng = Range("D1" & LastRow)

r = Application.Match(CLng(sDate), dateRng, 1)
If IsError(r) Then
frow = 2 ' first row i.e. start date is before first date in
column A
Else
frow = r
End If
lRow = Application.Match(CLng(fDate), dateRng, 1)
.Cells(frow, 1).Resize(lRow - frow + 1).EntireRow.Copy
WS2.Range("a13") '' I GET THE ERROR ON THIS LINE!!

End With

Application.ScreenUpdating = True

End Sub


Many thanks in advance.

Cheers

P

 

[Tom Ogilvy]

lRow = Application.Match(CLng(fDate), dateRng, 1)
if not iserror(lRow) then
.Cells(frow, 1).Resize(lRow - frow + 1) _
.EntireRow.Copy WS2.Range("a13")
end if

 

[harteorama]

Wow! many many thanks Tom, worked like a dream.

All the very best

Paul