Look up value on one sheet, copy other information, look up same value on other sheet and paste information

[ednis]

Hi
I have a multisheet workbook, on sheet "Import Data" I have a list of Job details with a number of columns , 4 of which are:

Job number Time 1 Time 2 Time 3 Time 4

This data is imported from an Access database which is updated daily

Within the workbook I also have a sheet "Schedule" also with the same information ( but from an earlier import ) which is formatted differently ( i.e. data on 4 rows across 2 columns ) i.e.

Job number Time 1
Time 2
Time 3
Time 4

I would like to:
Run down the list of job numbers on the "Import Data" sheet, pick up the Job Number value and copy the Time 1 - 4 values

Then open the "Scedule" sheet find the matching Job Number value and paste the new Time 1-4 values over the old values

I would need the loop to run down the full list on the "import Data" sheet.

Job Number is in C column on "import data" , Time 1 -4 are in K-N

Job Number is in A column on "import data" , Time 1 -4 are in D

I have tried sorting both sheets the same and then just simply running down the job numbers to copy and paste the time values but as each individual job data is stored on 4 rows of the schedule sheet I cannot get the sort to work, it would seem much easier if you could sort by groups of rows in Excel.
Any help would be greatly appreciated
Regards

Ted

 

[JLGWhiz]

Hi
I have a multisheet workbook, on sheet "Import Data" I have a list of Job details with a number of columns , 4 of which are:

Job number Time 1 Time 2 Time 3 Time 4

This data is imported from an Access database which is updated daily

Within the workbook I also have a sheet "Schedule" also with the same information ( but from an earlier import ) which is formatted differently ( i.e. data on 4 rows across 2 columns ) i.e.

Job number Time 1
Time 2
Time 3
Time 4

I would like to:
Run down the list of job numbers on the "Import Data" sheet, pick up the Job Number value and copy the Time 1 - 4 values

Then open the "Scedule" sheet find the matching Job Number value and paste the new Time 1-4 values over the old values

I would need the loop to run down the full list on the "import Data" sheet.

Job Number is in C column on "import data" , Time 1 -4 are in K-N

Job Number is in A column on "import data" , Time 1 -4 are in D

I have tried sorting both sheets the same and then just simply running down the job numbers to copy and paste the time values but as each individual job data is stored on 4 rows of the schedule sheet I cannot get the sort to work, it would seem much easier if you could sort by groups of rows in Excel.
Any help would be greatly appreciated
Regards

Ted

Try this on a copy or a mock up of your files before applying it to the original.

Code:
Sub moveIt()
Dim sh1 As Worksheet, sh2 As Worksheet, lr1 As Long, lr2 As Long, rng As Range
Set sh1 = Sheets("Import Data") 'Edit sheet name
Set sh2 = Sheets("Schedule") 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 3).End(xlUp).Row
Set rng = sh1.Range("C2:C" & lr1)
For Each c In rng
If c.Value <> "" Then
lr2 = sh2.Cells(Rows.Count, 4).End(xlUp).Row + 1
c.Copy sh2.Range("A" & lr2)
sh1.Range("K" & c.Row).Resize(1, 4).Copy
sh2.Range("D" & lr2).PasteSpecial Transpose:=True
End If
Next
End Sub
Code:

 

[JLGWhiz]

I believe I misread the OP. Here is a revision that might be more what you need. Again, test before applying to your original file.

Code:
Sub moveIt2()
Dim sh1 As Worksheet, sh2 As Worksheet, lr1 As Long, lr2 As Long, rng As Range
Set sh1 = Sheets("Import Data") 'Edit sheet name
Set sh2 = Sheets("Schedule") 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 3).End(xlUp).Row
Set rng = sh1.Range("C2:C" & lr1)
For Each c In rng
If c.Value <> "" Then
lr2 = sh2.Cells(Rows.Count, 4).End(xlUp).Row + 1
Set jNbr = sh2.Range("A" & lr2).Find(c.Value, LookIn:=xlValues)
If Not jNbr Is Nothing Then
sh1.Range("K" & c.Row).Resize(1, 4).Copy
sh2.Range("D" & jNbr.Row).PasteSpecial Transpose:=True
End If
End If
Next
End Sub

 

[ednis]

Hi
Thanks for the code , when I run it I get the following error :
Run time error '424'
Object required

In the code the - For Each c In rng
line is highlighted in yellow

Hope that makes sense
Regards
Ted

 

[JLGWhiz]

Hi
Thanks for the code , when I run it I get the following error :
Run time error '424'
Object required

In the code the - For Each c In rng
line is highlighted in yellow

Hope that makes sense
Regards
Ted

Add to the Dim statement as shown below:

Dim sh1 As Worksheet, sh2 As Worksheet, lr1 As Long, lr2 As Long, rng As Range, c As Range

 

[ednis]

HI
I still cant get it to work , is there a way I could send you the workbook and do you have time to take a look for me

regards

Ted

 

[JLGWhiz]

HI
I still cant get it to work , is there a way I could send you the workbook and do you have time to take a look for me

regards

Ted

Sorry, I do not take direct email for forum postings. Just describe what it is doing or not doing, what the error message is and which line of code has the highlight when you click Debug. We can work it out here.

 

[ednis]

Hi
No probs, thanks for the advice.
The code runs but only updates the times for the top job number on the schedule sheet
I should have said that on the schedule sheet the first Job Number is A29 but there is only the column header between that and the top of the column

Thanks

Regards

Ted

 

[JLGWhiz]

Hi
No probs, thanks for the advice.
The code runs but only updates the times for the top job number on the schedule sheet
I should have said that on the schedule sheet the first Job Number is A29 but there is only the column header between that and the top of the column

Thanks

Regards

Ted

The problem was my fault. I revised the code on the fly without testing it and it had bad syntax in the Find statement. So, here is another revision. Delete the old code and paste this one into your code module.

Code:
Sub moveIt3()
Dim sh1 As Worksheet, sh2 As Worksheet, lr1 As Long, lr2 As Long, rng As Range
Set sh1 = Sheets("Import Data") 'Edit sheet name
Set sh2 = Sheets("Schedule") 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 3).End(xlUp).Row
Set rng = sh1.Range("C2:C" & lr1)
For Each c In rng
If c.Value <> "" Then
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set jNbr = sh2.Range("A2:A" & lr2).Find(c.Value, LookIn:=xlValues)
If Not jNbr Is Nothing Then
sh1.Range("K" & c.Row).Resize(1, 4).Copy
sh2.Range("D" & jNbr.Row).PasteSpecial Transpose:=True
End If
End If
Next
End Sub
Code:

 

[ednis]

brilliant it works a treat , thanks very much

Ted