Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 -- HTH Bob Phillips "Anthony" wrote in message ... 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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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. "Bob Phillips" wrote: 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 -- HTH Bob Phillips "Anthony" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
stubborn Excel crash when editing code with code, one solution | Excel Programming | |||
option buttons run Click code when value is changed via VBA code | Excel Programming | |||
VBA code delete code but ask for password and unlock VBA protection | Excel Programming |