VB code help please

[Anthony]

Hi,
I have the following code which has been very kindly donated to be.
it basicaly searches a row for the input number and returns all the data on
that row. It keeps doing this until the entire column has been searched for
the input number.
Can anybody tell me who to change the code so that once the macro is
selected it automaticaly picks up 'todays date' and searches for that/
ie so once selected a search is made for all previouys data entered today
and displayed elswhere.
Many thanks - and go easy with the novice!

Sub print_mon_jobcard()
Dim i As Integer
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFirst As Range
Dim rngDestination As Range
Dim rngAllRecords As Range
Dim wks1 As Worksheet, wks2 As Worksheet

'On Error GoTo err_handler
i = InputBox("Please enter the job number you wish to print a job card for")
Set wks1 = ThisWorkbook.Worksheets("adhoc database")
Set wks2 = ThisWorkbook.Worksheets("adhoc database")

On Error Resume Next
Set rngToSearch = wks1.Columns("a")
Set rngDestination = wks2.Cells(Rows.Count, "a").End(xlUp).Offset(15, 0)

Set rngFound = rngToSearch.Find _
(What:=i, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rngFound Is Nothing Then
MsgBox "No job with the number " & i & _
" has been found, please try again! "
Else
On Error GoTo err_handler
Set rngFirst = rngFound
Set rngAllRecords = rngFound
Do
Set rngAllRecords = Union(rngAllRecords, rngFound)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
rngAllRecords.EntireRow.Copy rngDestination
wks3.PrintOut
End If
Exit Sub

err_handler:
MsgBox Error, , "Err " & Err.Number
End Sub

 

[Bob Phillips]

Sub print_mon_jobcard()
Dim i As Integer
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFirst As Range
Dim rngDestination As Range
Dim rngAllRecords As Range
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet

'On Error GoTo err_handler
Set wks1 = ThisWorkbook.Worksheets("adhoc database")
Set wks2 = ThisWorkbook.Worksheets("adhoc database")

On Error Resume Next
Set rngToSearch = wks1.Columns("A")
Set rngDestination = wks2.Cells(Rows.Count, "A").End(xlUp).Offset(15, 0)

Set rngFound = rngToSearch.Find _
(What:=Date, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rngFound Is Nothing Then
MsgBox "No job with the number " & i & _
" has been found, please try again! "
Else
On Error GoTo err_handler
Set rngFirst = rngFound
Set rngAllRecords = rngFound
Do
Set rngAllRecords = Union(rngAllRecords, rngFound)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
rngAllRecords.EntireRow.Copy rngDestination
wks3.PrintOut
End If
Exit Sub

err_handler:
MsgBox Error, , "Err " & Err.Number
End Sub

 

[GB]

Yeah Anthony, I was going to get back to you on that aspect. One thing
about what Bob shows you is that in the rare event that you are working say
near midnight, and say the update is done at 1130pm, and then attempted again
at 1201am, then anything that changed between those two times (Except between
midnight and 1201am) will be "lost" or at least not captured. If this is a
concern of yours, then you might want to try to figure out a worst case
scenario.

As for doing an "update", this will not really "update" the data, but rather
add on to the existing data.

BTW, I responded to your other question about copying and pasting a
particular range, if you check out the other thread you started yesterday.