date range lookup

[Guest]

I have a time tracking workbook that looks like this:

Work Order Time IN Time OUT

1234 2/13/2007 15:11 2/13/2007 16:28
1234 2/13/2007 16:55 2/13/2007 17:30

5678 2/14/2007 7:47 2/14/2007 12:00
5678 2/14/2007 12:30 2/14/2007 14:23


I want to enter a beginning and ending date into my destination workbook,
then have it search the data in the time tracking workbook and return me a
list of work orders within that time range.

Any suggestions on where is the best place to start?
Even a brief outline of the logic that would need to be applied would be
helpful at this point.

 

[Tom Ogilvy]

Dim dtStart as Date, dtEnd as Date
Dim cell as Range, sStr as String

dtStart = DateValue()
dtEnd = DateValue()

for each cell in Range("B3:B30")
if cell.Value <> "" then
if cell.Value >= dtStart and cell.offset(0,1).Value <= dtEnd then
sStr = sStr & cell.offset(0,-1).Value & vbNewline
end if
End if
Next
if sStr <> "" then
msgbox sStr
End if

 

[Guest]

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?

 

[Tom Ogilvy]

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

 

[Guest]

Tom,

That was exactly what I was looking for.
Thank you again so very much!

- Jay