Object variable issue. Solution eluding me :(

[Kinseres]

Hi all I'm having an issue with a piece of code that's designed to seach for a date in another workbook, copy the data next to that date and paste it next to the corresponding date in ThisWorkbook.

Since this code will be run daily, but the data from the source file is liable to change from time to time, I have tried to set the code to loop and repeat for every day of the year to date each time it is run.

The code works very well up until we get to actually pasting the copied data, which is when I get a "Object variable or With block variable not set" error code and the sub bugs out.

I cant figure out where the variable it has an issue with is. I'm using the same methodology to locate the searched date in both the source and destination files, and it works fine when locating in the source file. Just not in the destination file.

Any help would be greatly appreciated.

Function Actual_Demand()
Dim SearchDate As Date
Dim FindRange As Range
Dim FindRange2 As Range
Dim i As Integer
Dim EndDate As Date
Dim StartDate As Date
Dim LoopCount As Integer


SearchDate = Sheets("R1").Range("B1").Cells(Rows.Count, 1).End(xlUp).Offset(1, -1).Value 'Looks for last row of data in column B and reads the date from the next row in column A
Filepath = "[I]filepath[/I]"
Filename = "[I]filename[/I]"
Workbooks.Open Filename:="[I]filepath & filename[/I]", Format:=xlDelimited, local:=True
StartDate = Workbooks(Filename).Sheets("History").Range("A13154") 'Cell containing 1st day of year
Columns("A:A").Find(SearchDate).Activate
EndDate = ActiveCell
LoopCount = EndDate - StartDate
SearchDate = StartDate
For i = 1 To LoopCount
Set FindRange = Columns("A:A").Find(SearchDate)
If FindRange Is Nothing Then
    MsgBox ("Imported to last recorded date" & EndDate)
    Exit Function
ElseIf Not FindRange Is Nothing Then


    FindRange.Activate
    ActiveCell.Offset(0, 1).Activate
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
    Selection.Copy

     *** Error Occurs after this line ***

    ThisWorkbook.Activate
    Set FindRange2 = Columns("A:A").Find(SearchDate)
    FindRange2.Activate
    ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues
 SearchDate = SearchDate + 1
End If
Next i
Workbooks(Filename).Close (False)
End Function

 

[Norie]

Where in the code do you get the error?

 

[Kinseres]

Sorry, ive highlighted that in the code now

 

[Fluff]

What happens if you use this

ThisWorkbook.Activate
Set findrange2 = Columns("A:A").find(searchdate)
If findrange2 Is Nothing Then MsgBox searchdate & " not found": Exit Sub
findrange2.Offset(0, 1).PasteSpecial xlPasteValues
searchdate = searchdate + 1

 

[Kinseres]

What happens if you use this

ThisWorkbook.Activate
Set findrange2 = Columns("A:A").find(searchdate)
If findrange2 Is Nothing Then MsgBox searchdate & " not found": Exit Sub
findrange2.Offset(0, 1).PasteSpecial xlPasteValues
searchdate = searchdate + 1

Genius

That suggestion got me on to the right track, thanks Fluff

I had to throw in a Workbooks(Filename).Activate at the start of the loop and tweak your suggested code to the below to make it work, but it works beautifully now

ThisWorkbook.Activate
    Set FindRange2 = ActiveWorkbook.Sheets("R1").Range("A:A").Find(SearchDate)
    If FindRange2 Is Nothing Then MsgBox SearchDate & " not found": Exit Function
    FindRange2.Offset(0, 1).PasteSpecial xlPasteValues
 SearchDate = SearchDate + 1

I suspect my original code line Set FindRange2 = Columns("A:A").Find(SearchDate) wasn't working because of multiple sheets in the destination workbook.

Thanks very much Fluff; you're a life saver