Copy Columns Based off VLookUp Result

[richardSmith]

I am using Vlookup to match up animal names from between 2 workbooks. What I am wanting to do from there, is update the feeding dates/times in workbook Incomplete, with the data in workbook Complete. Problem is they are not in the same order between the two workbooks, so I thought maybe use VLOOKUP to find the animal name, but I don't know how to pull in the corresponding feeding times? I am uploading snippet workbooks to see if someone could please help me.

[Zack Barresse]

Hi there,

If you're just looking to update columns B through G of your 'Correct' data file, to columns C through H of your 'Incorrect' data file, that's no problem. There's some assumptions here though. Assuming:

• Both files will be open
• Both file names won't change
• Sheets are both named "Sheet1" (can change in the code if they are not)
• Range on 'Correct' will stay the same - headers in row 1, animals in col A, all headers remain in those columns
• Range on 'Incorrect' will stay the same - headers in row 1, animals in col B, all headers remain in those columns
• Values will be overwritten

Assuming all of that, you can put this code into a standard module of your 'Incorrect' file...

[vba]Option Explicit

Sub TransferData()

Dim wbData As Workbook
Dim wbDest As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim rCell As Range
Dim rLook As Range
Dim WF As WorksheetFunction
Dim iRow As Long
Dim xMatch As Variant

Call TOGGLEEVENTS(False)

On Error Resume Next
Set wbData = Workbooks("Master_Correct_data.xlsx")
Set wbDest = ThisWorkbook
Set wsData = wbData.Worksheets("Sheet1")
Set wsDest = wbDest.Worksheets("Sheet1")
On Error GoTo 0
If Err.Number <> 0 Then GoTo ExitRoutine

Set rLook = wsDest.Range("B2:B" & wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row)
Set WF = Application.WorksheetFunction

For Each rCell In rLook.Cells

On Error Resume Next
xMatch = WF.Match(rCell.Value, wsData.Columns(1), 0)
On Error GoTo 0

If xMatch > 0 Then
rCell.Offset(0, 1).Resize(1, 6).Value = wsData.Cells(xMatch, 2).Resize(1, 6).Value
End If

Next rCell

ExitRoutine:
Call TOGGLEEVENTS(True)

If Err.Number <> 0 Then
MsgBox "There was an error.", vbCritical, "ERROR!"
Else
MsgBox "All values have been updated successfully.", vbExclamation, "SUCCESS!"
End If

End Sub

Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
Application.DisplayAlerts = blnState
Application.EnableEvents = blnState
Application.ScreenUpdating = blnState
If blnState Then Application.CutCopyMode = False
If blnState Then Application.StatusBar = False
End Sub[/vba]

To put into a standard module:

• Open the VBE (Alt + F11)
• Open the Project Explorer (PE) Ctrl + R
• Find your file/project, insert a module (Insert -> Module)
• Paste code

Works for me on testing. This should work in multiple versions, although your file format is 2007 and up.

[richardSmith]

That works great! One slight change (sorry I didn't say this from the beginning) would it be possible to have the copy range go from C to L?

There are a couple of additional rows over there that I need copied also. Sorry for the change.

[Zack Barresse]

Sure. The Resize is what gets columns B through G. So all you would need to do is change the Resize values from (1, 6) to (1, 10). This will grab data from the Correct sheet, columns B through K, and transfer to the Incorrect sheet, columns C through L. You MUST change both instances of the Resize, there is 2 of them.

Edit: Also, please remember this overwrites all cell values and won't check for duplicate values. That means there will be no warning once you run the routine, and all values will be overwritten if there is a match found. It also means that it may take longer on large data sets. FYI.