Sub Get_Work_Orders()

Dim dtStart As Date, dtEnd As Date
Dim cell As Range, sStr As String
Dim TimeSrcRng As Range
Dim mySourceWkbkName2 As String
Dim cell1 as Range

mySourceWkbkName2 = "F:\files\ProjTimeTracking.xls"

set cell1 = Activesheet.Range("B4")

Set TimeSrcRng = Nothing
On Error Resume Next
Set TimeSrcRng = Workbooks.Open( _
Filename:=mySourceWkbkName2, _
ReadOnly:=True) _
.Worksheets("Time Check Log") _
.Range("C3:C3000")
On Error GoTo 0

If TimeSrcRng Is Nothing Then
MsgBox "Something wrong with source range!"
Exit Sub
End If

dtStart = DateValue(ThisWorkbook.Sheets("Sheet1").Range("D1" ))
dtEnd = DateValue(ThisWorkbook.Sheets("Sheet1").Range("F1" ))

For Each cell In TimeSrcRng
If cell.Value < "" Then
If cell.Value = dtStart And cell.Offset(0, 1).Value <= dtEnd
Then
cell1 = cell.Offset(0, -2).Value
set cell1 = cell1.offset(1,0)
End If
End If
Next


'close the sending workbook
TimeSrcRng.Parent.Parent.Close savechanges:=False

End Sub


--
Regards,
Tom Ogilvy

"Jay" wrote in message
...
Tom, That works like a charm!
The msgBox displays exactly the information I would like to be populated
in
a list of cells starting with cell B4 in my destination workbook. I'm not
quite sure how to get this list to populate the cells. I assume I would
need
to use a For/Next statement within the existing nested If statement?
Here's what I've got, but I'm not sure how to generate the list into my
spreadsheet with the information that now shows up in the msgBox:

Sub Get_Work_Orders()

Dim dtStart As Date, dtEnd As Date
Dim cell As Range, sStr As String
Dim TimeSrcRng As Range
Dim mySourceWkbkName2 As String

mySourceWkbkName2 = "F:\files\ProjTimeTracking.xls"

Set TimeSrcRng = Nothing
On Error Resume Next
Set TimeSrcRng = Workbooks.Open(Filename:=mySourceWkbkName2,
ReadOnly:=True) _
.Worksheets("Time Check Log").Range("C3:C3000")
On Error GoTo 0

If TimeSrcRng Is Nothing Then
MsgBox "Something wrong with source range!"
Exit Sub
End If

dtStart = DateValue(ThisWorkbook.Sheets("Sheet1").Range("D1" ))
dtEnd = DateValue(ThisWorkbook.Sheets("Sheet1").Range("F1" ))

For Each cell In TimeSrcRng
If cell.Value < "" Then
If cell.Value = dtStart And cell.Offset(0, 1).Value <= dtEnd
Then
sStr = sStr & cell.Offset(0, -2).Value & vbNewLine
End If
End If
Next
If sStr < "" Then
MsgBox sStr
End If

'close the sending workbook
TimeSrcRng.Parent.Parent.Close savechanges:=False

End Sub

Any Suggestions?