Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Macro VB code help
Hi,
I have the following code (donated) which will take a number input by the user and then seach a whole column for that corresponding number. Once found it will then copy/paste the whole of that rows data onto another worksheet. This works fine as there is never the same number in the column twice, what I now need is for the column to be searched and then each time the same number is found to copy each rows data onto a seperate sheet until all the 'input number' corresponding rows data has been pasted onto seperate rows in a new worksheet. For example, if the number input by the user is 12345 . The seach is made and its found that this number is shown in cells A3, A7, A10 I want all the data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in another worksheet. hope that makes sense, and here is the code I have.... Sub print_mon_jobcard() Dim i As Integer Dim iRow As Integer Dim Cel As Range Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet Dim lLastRow As Long 'On Error GoTo err_handler Set wks1 = ThisWorkbook.Worksheets("monday's log") Set wks2 = ThisWorkbook.Worksheets("formula") Set wks3 = ThisWorkbook.Worksheets("jobcard") i = InputBox("Please enter the job number you wish to print a job card for") On Error Resume Next Set Cel = wks1.Columns("B:B").Find _ (What:=i, _ LookIn:=xlValues, _ LookAt:=xlWhole) If Cel Is Nothing Then MsgBox "No job with the number " & i & _ " has been found, please try again! " Exit Sub End If On Error GoTo err_handler iRow = Cel.Row wks1.Cells(iRow, 1).EntireRow.Copy Destination _ :=wks2.Cells(2, 1) wks3.PrintOut Exit Sub err_handler: MsgBox Error, , "Err " & Err.Number End Sub |
#2
|
|||
|
|||
Hi Anthony,
Here's some code that does what you want, I believe. You will have to change the worksheet name to match yours. However, I cannot figure out the error handling in case there is no number entered in the Input box or a number that does not exist. I'll post the code to the group and see if I can get the error handling fixed and get back to you. Sub TransferIt() Dim i As Long Dim Rng As Range Dim c As Range Dim j As Long i = Cells(Rows.Count, "A").End(xlUp).Row Set Rng = Range("A2:A" & i) j = InputBox("Please enter the job" & vbCr & _ "number you wish to" & vbCr & "print a job card for") For Each c In Rng If c.Value = j Then c.Resize(1, 7).Copy Sheets("Sheet2"). _ Range("G100").End(xlUp).Offset(1, 0) End If Next End Sub HTH Regards, Howard "Anthony" wrote in message ... Hi, I have the following code (donated) which will take a number input by the user and then seach a whole column for that corresponding number. Once found it will then copy/paste the whole of that rows data onto another worksheet. This works fine as there is never the same number in the column twice, what I now need is for the column to be searched and then each time the same number is found to copy each rows data onto a seperate sheet until all the 'input number' corresponding rows data has been pasted onto seperate rows in a new worksheet. For example, if the number input by the user is 12345 . The seach is made and its found that this number is shown in cells A3, A7, A10 I want all the data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in another worksheet. hope that makes sense, and here is the code I have.... Sub print_mon_jobcard() Dim i As Integer Dim iRow As Integer Dim Cel As Range Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet Dim lLastRow As Long 'On Error GoTo err_handler Set wks1 = ThisWorkbook.Worksheets("monday's log") Set wks2 = ThisWorkbook.Worksheets("formula") Set wks3 = ThisWorkbook.Worksheets("jobcard") i = InputBox("Please enter the job number you wish to print a job card for") On Error Resume Next Set Cel = wks1.Columns("B:B").Find _ (What:=i, _ LookIn:=xlValues, _ LookAt:=xlWhole) If Cel Is Nothing Then MsgBox "No job with the number " & i & _ " has been found, please try again! " Exit Sub End If On Error GoTo err_handler iRow = Cel.Row wks1.Cells(iRow, 1).EntireRow.Copy Destination _ :=wks2.Cells(2, 1) wks3.PrintOut Exit Sub err_handler: MsgBox Error, , "Err " & Err.Number End Sub |
#3
|
|||
|
|||
Hi,
Thanks for kind help, I'll give it a go and post back how I get On Many thanks "L. Howard Kittle" wrote: Hi Anthony, Here's some code that does what you want, I believe. You will have to change the worksheet name to match yours. However, I cannot figure out the error handling in case there is no number entered in the Input box or a number that does not exist. I'll post the code to the group and see if I can get the error handling fixed and get back to you. Sub TransferIt() Dim i As Long Dim Rng As Range Dim c As Range Dim j As Long i = Cells(Rows.Count, "A").End(xlUp).Row Set Rng = Range("A2:A" & i) j = InputBox("Please enter the job" & vbCr & _ "number you wish to" & vbCr & "print a job card for") For Each c In Rng If c.Value = j Then c.Resize(1, 7).Copy Sheets("Sheet2"). _ Range("G100").End(xlUp).Offset(1, 0) End If Next End Sub HTH Regards, Howard "Anthony" wrote in message ... Hi, I have the following code (donated) which will take a number input by the user and then seach a whole column for that corresponding number. Once found it will then copy/paste the whole of that rows data onto another worksheet. This works fine as there is never the same number in the column twice, what I now need is for the column to be searched and then each time the same number is found to copy each rows data onto a seperate sheet until all the 'input number' corresponding rows data has been pasted onto seperate rows in a new worksheet. For example, if the number input by the user is 12345 . The seach is made and its found that this number is shown in cells A3, A7, A10 I want all the data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in another worksheet. hope that makes sense, and here is the code I have.... Sub print_mon_jobcard() Dim i As Integer Dim iRow As Integer Dim Cel As Range Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet Dim lLastRow As Long 'On Error GoTo err_handler Set wks1 = ThisWorkbook.Worksheets("monday's log") Set wks2 = ThisWorkbook.Worksheets("formula") Set wks3 = ThisWorkbook.Worksheets("jobcard") i = InputBox("Please enter the job number you wish to print a job card for") On Error Resume Next Set Cel = wks1.Columns("B:B").Find _ (What:=i, _ LookIn:=xlValues, _ LookAt:=xlWhole) If Cel Is Nothing Then MsgBox "No job with the number " & i & _ " has been found, please try again! " Exit Sub End If On Error GoTo err_handler iRow = Cel.Row wks1.Cells(iRow, 1).EntireRow.Copy Destination _ :=wks2.Cells(2, 1) wks3.PrintOut Exit Sub err_handler: MsgBox Error, , "Err " & Err.Number End Sub |
#4
|
|||
|
|||
Hi Anthony,
Here is some revised code with some error handling, thanks to Dave Peterson. Sub TransferItx() Dim i As Long Dim Rng As Range Dim c As Range Dim j As Long Dim res As Variant i = Cells(Rows.Count, "A").End(xlUp).Row Set Rng = Range("A2:A" & i) j = CLng(Application.InputBox("Please enter the job" & vbCr & _ "number you wish to" & vbCr & "print a job card for", Type:=1)) If j = 0 Then Exit Sub End If If IsError(res) Then MsgBox "Not found!" Else For Each c In Rng If c.Value = j Then c.Resize(1, 7).Copy Sheets("Sheet2"). _ Range("G100").End(xlUp).Offset(1, 0) End If Next End If End Sub Regards, Howard "Anthony" wrote in message ... Hi, I have the following code (donated) which will take a number input by the user and then seach a whole column for that corresponding number. Once found it will then copy/paste the whole of that rows data onto another worksheet. This works fine as there is never the same number in the column twice, what I now need is for the column to be searched and then each time the same number is found to copy each rows data onto a seperate sheet until all the 'input number' corresponding rows data has been pasted onto seperate rows in a new worksheet. For example, if the number input by the user is 12345 . The seach is made and its found that this number is shown in cells A3, A7, A10 I want all the data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in another worksheet. hope that makes sense, and here is the code I have.... Sub print_mon_jobcard() Dim i As Integer Dim iRow As Integer Dim Cel As Range Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet Dim lLastRow As Long 'On Error GoTo err_handler Set wks1 = ThisWorkbook.Worksheets("monday's log") Set wks2 = ThisWorkbook.Worksheets("formula") Set wks3 = ThisWorkbook.Worksheets("jobcard") i = InputBox("Please enter the job number you wish to print a job card for") On Error Resume Next Set Cel = wks1.Columns("B:B").Find _ (What:=i, _ LookIn:=xlValues, _ LookAt:=xlWhole) If Cel Is Nothing Then MsgBox "No job with the number " & i & _ " has been found, please try again! " Exit Sub End If On Error GoTo err_handler iRow = Cel.Row wks1.Cells(iRow, 1).EntireRow.Copy Destination _ :=wks2.Cells(2, 1) wks3.PrintOut Exit Sub err_handler: MsgBox Error, , "Err " & Err.Number End Sub |
#5
|
|||
|
|||
Many thanks
what would I do without you guys "L. Howard Kittle" wrote: Hi Anthony, Here is some revised code with some error handling, thanks to Dave Peterson. Sub TransferItx() Dim i As Long Dim Rng As Range Dim c As Range Dim j As Long Dim res As Variant i = Cells(Rows.Count, "A").End(xlUp).Row Set Rng = Range("A2:A" & i) j = CLng(Application.InputBox("Please enter the job" & vbCr & _ "number you wish to" & vbCr & "print a job card for", Type:=1)) If j = 0 Then Exit Sub End If If IsError(res) Then MsgBox "Not found!" Else For Each c In Rng If c.Value = j Then c.Resize(1, 7).Copy Sheets("Sheet2"). _ Range("G100").End(xlUp).Offset(1, 0) End If Next End If End Sub Regards, Howard "Anthony" wrote in message ... Hi, I have the following code (donated) which will take a number input by the user and then seach a whole column for that corresponding number. Once found it will then copy/paste the whole of that rows data onto another worksheet. This works fine as there is never the same number in the column twice, what I now need is for the column to be searched and then each time the same number is found to copy each rows data onto a seperate sheet until all the 'input number' corresponding rows data has been pasted onto seperate rows in a new worksheet. For example, if the number input by the user is 12345 . The seach is made and its found that this number is shown in cells A3, A7, A10 I want all the data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in another worksheet. hope that makes sense, and here is the code I have.... Sub print_mon_jobcard() Dim i As Integer Dim iRow As Integer Dim Cel As Range Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet Dim lLastRow As Long 'On Error GoTo err_handler Set wks1 = ThisWorkbook.Worksheets("monday's log") Set wks2 = ThisWorkbook.Worksheets("formula") Set wks3 = ThisWorkbook.Worksheets("jobcard") i = InputBox("Please enter the job number you wish to print a job card for") On Error Resume Next Set Cel = wks1.Columns("B:B").Find _ (What:=i, _ LookIn:=xlValues, _ LookAt:=xlWhole) If Cel Is Nothing Then MsgBox "No job with the number " & i & _ " has been found, please try again! " Exit Sub End If On Error GoTo err_handler iRow = Cel.Row wks1.Cells(iRow, 1).EntireRow.Copy Destination _ :=wks2.Cells(2, 1) wks3.PrintOut Exit Sub err_handler: MsgBox Error, , "Err " & Err.Number End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VLOOKUP for Zip Code Ranges | Excel Worksheet Functions | |||
Macro for changing text to Proper Case | Excel Worksheet Functions | |||
Help with macro looping and color query function | Excel Discussion (Misc queries) | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
macro code shortcut | Excel Worksheet Functions |