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

GijoeBlack

New Member
Joined
Sep 22, 2021
Messages
18
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
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 (y) in Worksheet (1) of Workbook(A) in Worksheet (2) of Workbook (B). If cell value (y) 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

Well-known Member
Joined
Nov 26, 2020
Messages
1,761
Office Version
  1. 2016
Platform
  1. Windows
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.

Rich (BB 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

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
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

GijoeBlack

New Member
Joined
Sep 22, 2021
Messages
18
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
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

New Member
Joined
Sep 22, 2021
Messages
18
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
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

Well-known Member
Joined
Nov 26, 2020
Messages
1,761
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
1,761
Office Version
  1. 2016
Platform
  1. Windows
Here's modified code
VBA 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
 
Solution

GijoeBlack

New Member
Joined
Sep 22, 2021
Messages
18
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
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 :)
 

Forum statistics

Threads
1,143,909
Messages
5,721,465
Members
422,363
Latest member
Bogus_Potatoes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top