Copy a cell value (x) from one Workbook (A) to Workbook (B) if finds a lookup cell value (y) from Workbook (A)

[GijoeBlack]

Apologies if this has been already discussed and resolved. Unfortunately, I could not find anything close to what am trying to achieve. I have attempted several ways and have not been successful. It should be noted, am a complete novice in VBA. Here is the use case, am looking to resolve in form of a VBA code.

I have Workbook (A) [Source] and Workbook (B) [Destination]. I would like to setup a macro within Workbook (A) to open Workbook (B) and copy a cell value (x) within Worksheet (1) of a Workbook (A) but look up/Find a Cell value in Worksheet (1) of Workbook(A) in Worksheet (2) of Workbook (B). If cell value is found, would like to Paste cell value (x) to the same row but offset by (4) columns, close Workbook (B). I may later copy more than one cell value from source to destination. But I believe if I can get this to work, I will be able to figure out the rest.

I thank you all in advance.

Joe.

 

[Zot]

This code will quietly open target file, write total, save and close. It will find use Invoice Number: and TOTAL: as keywords to get invoice number and value to be copied. You just need to set the full path to wbTarget to get it to work.

Sub WriteInvAmt()

Dim NoInv As Long
Dim TotalLoc As String
Dim rngInv As Range, rngFound As Range
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim wbSource As Workbook, wbTarget As Workbook

Set wbSource = ActiveWorkbook
Set wsSource = wbSource.Sheets("Invoice")

Application.ScreenUpdating = False

Set wbTarget = Workbooks.Open(Filename:="Set you wbTarget path here", UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
Set wsTarget = wbTarget.Sheets("INV Summary")

' Set range of Invoice numbers in wsTarget
Set rngInv = wsTarget.Range("C2", wsTarget.Cells(Rows.Count, "C").End(xlUp))

' Search for Invoice Number in wsSource
Set rngFound = wsSource.Cells.Find(What:="Invoice Number:", LookAt:=xlWhole)
NoInv = rngFound.Offset(0, 1)

' Search for Invoice Total location
Set rngFound = wsSource.Cells.Find(What:="Total:", LookAt:=xlWhole)
TotalLoc = rngFound.Offset(0, 1).Address

' Find matching invoice number in wsTarget
Set rngFound = rngInv.Find(What:=NoInv, LookAt:=xlWhole)
If Not rngFound Is Nothing Then
    rngFound.Offset(0, 3) = wsSource.Range(TotalLoc)
End If
' Save and Close wbTarget
wbTarget.Close True

End Sub

 

[GijoeBlack]

Sub WriteInvAmt() Dim NoInv As Long Dim TotalLoc As String Dim rngInv As Range, rngFound As Range Dim wsSource As Worksheet, wsTarget As Worksheet Dim wbSource As Workbook, wbTarget As Workbook Set wbSource = ActiveWorkbook Set wsSource = wbSource.Sheets("Invoice") Application.ScreenUpdating = False Set wbTarget = Workbooks.Open(Filename:="Set you wbTarget path here", UpdateLinks:=False, IgnoreReadOnlyRecommended:=True) Set wsTarget = wbTarget.Sheets("INV Summary") ' Set range of Invoice numbers in wsTarget Set rngInv = wsTarget.Range("C2", wsTarget.Cells(Rows.Count, "C").End(xlUp)) ' Search for Invoice Number in wsSource Set rngFound = wsSource.Cells.Find(What:="Invoice Number:", LookAt:=xlWhole) NoInv = rngFound.Offset(0, 1) ' Search for Invoice Total location Set rngFound = wsSource.Cells.Find(What:="Total:", LookAt:=xlWhole) TotalLoc = rngFound.Offset(0, 1).Address ' Find matching invoice number in wsTarget Set rngFound = rngInv.Find(What:=NoInv, LookAt:=xlWhole) If Not rngFound Is Nothing Then rngFound.Offset(0, 3) = wsSource.Range(TotalLoc) End If ' Save and Close wbTarget wbTarget.Close True End Sub

Beautiful. Exactly what Im trying to achieve. I will give it a shot and report back. I can't thank you enough for help and guidance.

Cheers

 

[GijoeBlack]

So that worked like a charm [as a final test, I still have to test using the Sharepoint path]. Is there a way to include to the user that the Field was successfully copied else if there is an issue, message an error coping value or something?

Thanks again

 

[Zot]

So that worked like a charm [as a final test, I still have to test using the Sharepoint path]. Is there a way to include to the user that the Field was successfully copied else if there is an issue, message an error coping value or something?

Thanks again

Maybe give message that Invoice No xxxxx amounting xxxxx has been copied. If no Invoice No found, can also notify

 

[Zot]

Here's modified code

Sub WriteInvAmt()

Dim NoInv As Long
Dim TotalLoc As String
Dim rngInv As Range, rngFound As Range
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim wbSource As Workbook, wbTarget As Workbook

Set wbSource = ActiveWorkbook
Set wsSource = wbSource.Sheets("Invoice")

Application.ScreenUpdating = False

 ' Modify Filename and path here
Set wbTarget = Workbooks.Open(Filename:="Set you wbTarget path here", UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
Set wsTarget = wbTarget.Sheets("INV Summary")

' Set range of Invoice numbers in wsTarget
Set rngInv = wsTarget.Range("C2", wsTarget.Cells(Rows.Count, "C").End(xlUp))

' Search for Invoice Number in wsSource
Set rngFound = wsSource.Cells.Find(What:="Invoice Number:", LookAt:=xlWhole)
NoInv = rngFound.Offset(0, 1)

' Search for Invoice Total location
Set rngFound = wsSource.Cells.Find(What:="Total:", LookAt:=xlWhole)
TotalLoc = rngFound.Offset(0, 1).Address

' Find matching invoice number in wsTarget
Set rngFound = rngInv.Find(What:=NoInv, LookAt:=xlWhole)
If Not rngFound Is Nothing Then
    rngFound.Offset(0, 3) = wsSource.Range(TotalLoc)
    MsgBox "Invoice No : " & NoInv & vbLf & "Amount = " & wsSource.Range(TotalLoc)
Else
    MsgBox "Invoice Number not found" & vbLf & "Writing process terminated"
End If
' Save and Close wbTarget
wbTarget.Close True

End Sub

 

[GijoeBlack]

Maybe give message that Invoice No xxxxx amounting xxxxx has been copied. If no Invoice No found, can also notify

Just perfect. A million thanks