Solved: Lookup Value, Copy and Paste Row Values?!

[SDave]

Does anyone know if it is possible, or have a VBA code that looks up (VLOOKUP) a value in a different workbook and then copy and pastes values into the corresponding row?!

I have two workbooks, one called Input Capture and one called Talent Tool. Both have the same range D12:U1100. What I would like is to look up the value in column D in my Talent Tool, in let's say sheet1 and copy and paste the values from my Input Capture workbook, lets say sheet 2 for arguements sake.

I did stumble across the following code but I can't get it to function correctly:

On Error Resume Next
Workbooks.Open ("P:\Group Reward\Team\Sam\Succession Planning Templates\Test\Talent Tool.xls")
ThisWorkbook.Activate
For Each cell In Workbooks("Talent Tool.xls").Sheets("Sheet 1").Range("D12:U1100")
If cell.Value = Range("D121100").Value Then
cell.Offset(0, 5).Value = Range("D12:U1100").Value
Exit Sub
End If
Next cell
End Sub

Any help would be greatly appreciated.

[mdmackillop]

Hi Dave,
Welcome to vbax
Can you post a sample workbook containing the data in 2 sheets, showing what end result you are after? We can code for the different workbooks as required.
Use Manage Attachments in the Go Advanced reply section.
Regards
MD

[SDave]

Hi MD,

Thanks for getting back to me.

I've uploaded a sample FYI.

What I would like is for users to populate the Talent Tool Capture file, notably the "People Data" tab. Once the template has been populated I would like to automatically transfer the populated data to the Talent Tool, again populating the "People Data" tab.

Columns I:U need populating with the corresponding row value, I do however need both Columns M and Q to be skipped over on the "People Data" tab in the Talent Tool seeing as they both contain pre defined formulas.

The look up value should be the Employee ID number which can be found in Column D of both worksheets.

Thanks,

Sam

[mdmackillop]

A a glance, both files appear identical. I'm just not clear what is meant to happen.

[SDave]

Apologies MD. I had to strip out a load of additonal sheets and data from the Talent Tool just so that I could upload the file.

It would probably be best for me to give you an example of what I need.

Take row 12 for example on the Talent Tool Capture > People Data tab. Once the row has been populated with a users changes, I would like the macro to lookup the employee number in Talent Tool > People Data and copy and paste the entered values into the corresponding row, whilst excluding columns M and Q.

[mdmackillop]

Try this, It is set to copy a single row, but can be looped if required.
[vba]
Option Explicit
Sub CopyData()
Dim EmpId As Range
Dim WB As Workbook
Dim WS As Worksheet
Dim c As Range
Application.EnableEvents = False
On Error Resume Next
Set EmpId = Cells(ActiveCell.Row, "D")
Set WB = Workbooks("Talent Tools.xls")
If WB Is Nothing Then
Set WB = Workbooks.Open("C:\AAA\Talent Tool.xls") '<=== Change to suit
End If
Set WS = WB.Sheets("People Data")
Set c = WS.Columns(4).Find(EmpId.Value, lookat:=xlWhole)
If Not c Is Nothing Then
EmpId.Offset(, 1).Resize(, 8).Copy
c.Offset(, 1).PasteSpecial xlPasteValues
EmpId.Offset(, 10).Resize(, 3).Copy
c.Offset(, 10).PasteSpecial xlPasteValues
EmpId.Offset(, 14).Resize(, 4).Copy
c.Offset(, 14).PasteSpecial xlPasteValues
End If
Application.EnableEvents = True
End Sub

[/vba]

[SDave]

Thanks MD, the code you've supplied does exactly what I am after. Is it possible to transfer all changes at once?!

At the moment the code only transfers the values entered into a chosen row.

Take for example Employee ID: 3577686, I've entered a some random values which have been copied across, however when I've done the same for Employee ID: 3619933 nothing has been copied across. Does there need to be some sort of loop?

Apologies, I know I'm asking a lot. Believe me, your help has been much appreciated.

Thanks.

[mdmackillop]

No problem
[vba]
Sub CopyData()
Dim EmpId As Range
Dim WB As Workbook
Dim WS As Worksheet
Dim c As Range
Dim Rng As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
Set WB = Workbooks("Talent Tool.xls")
If WB Is Nothing Then
Set WB = Workbooks.Open("C:\AAA\Talent Tool.xls") '<=== Change to suit
End If
Set WS = WB.Sheets("People Data")
With ThisWorkbook.Sheets("People Data")
Set Rng = Range(.Cells(12, 4), .Cells(Rows.Count, 4).End(xlUp))
End With
For Each EmpId In Rng
Set c = WS.Columns(4).Find(EmpId.Value, lookat:=xlWhole)
If Not c Is Nothing Then
EmpId.Offset(, 1).Resize(, 8).Copy
c.Offset(, 1).PasteSpecial xlPasteValues
EmpId.Offset(, 10).Resize(, 3).Copy
c.Offset(, 10).PasteSpecial xlPasteValues
EmpId.Offset(, 14).Resize(, 4).Copy
c.Offset(, 14).PasteSpecial xlPasteValues
End If
Next
WB.Save
WB.Close
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[/vba]

[SDave]

Thanks MD. However the revised code does not seem to be working. The corresponding file is opened, saved and closed however no vlaues are being copied over this time around?

Have I missed something out?

[mdmackillop]

A typo in the workbook name, I think. I've corrected the code in post #8

[SDave]

Thanks MD, you're an absolute star. Much appreciated!!!

[SDave]

Hi MD,

I have a slight problem, however nothing major. The code you so kindly provided works a treat however, it seems to skip columns L, P, U and V, (please see Capture Tool1).

[vba]
Sub PepCopyData()
Dim EmpId As Range
Dim WB As Workbook
Dim WS As Worksheet
Dim c As Range
Dim Rng As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
Set WB = Workbooks("Talent Tool.xls")
If WB Is Nothing Then
Set WB = Workbooks.Open("P:\Group Reward\Team\Sam\Succession Planning Templates\BETA\Talent Tool - TEST v2.xls") '<=== Change to suit
End If
Set WS = WB.Sheets("People_Data")
With ThisWorkbook.Sheets("People_Data")
Set Rng = Range(.Cells(12, 3), .Cells(Rows.Count, 3).End(xlUp))
End With
For Each EmpId In Rng
Set c = WS.Columns(3).Find(EmpId.Value, lookat:=xlWhole)
If Not c Is Nothing Then
EmpId.Offset(, 1).Resize(, 8).Copy
c.Offset(, 1).PasteSpecial xlPasteValues
EmpId.Offset(, 10).Resize(, 3).Copy
c.Offset(, 10).PasteSpecial xlPasteValues
EmpId.Offset(, 14).Resize(, 4).Copy
c.Offset(, 14).PasteSpecial xlPasteValues
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox ("Data Transferred")
End Sub
[/vba]

Is it possible for me to manually alter the above?! If so which section would I need to alter?!

In addition I have used the same code on another worksheet within my workbook, however it skips column L (please see Capture Tool2).

FYI the Main Data sheets are what the Capture Tool feeds.

I should also mention that I had to move one column to the end of the worksheet. The Emp Status column was previously situated in Column C.

The Capture Tool1 and Main Data1 worksheets contain formulas in Columns M and Q which shouldn't be overwritten.


Thanks.