copy from one WB to another if cell match found

si3po

Board Regular
Joined
Jan 7, 2019
Messages
91
Office Version
  1. 365
Platform
  1. Windows
Hi all,

rather than beat about the bush with a ling description, here's what i'm trying to do....

Situation :
  • 2 workbooks - WB1 = main data, WB2 = new data (filtered)
  • 1 'helper' column on each sheet with data formatted the same (e.g. pn/order no/customer)
  • icounter = rows counter for WB2
Requirement:
  • look at icounter, find this row in WB2
  • take value in helper column of WB2 (Col A) from this row
  • find a match for value in WB1 helper column (Col AA)
  • for each match found: Copy value from 'L' in row of WB2
  • paste WB2 value into WB1 cell 'R'
  • increase iCounter value by 1
  • repeat until end of rows of WB2

i've got the following code so far, but for some reason it isn't working... it appears that it finds nil values in my WB2 and therefore continually exits the 'find' if loop moving to the next WB2 row.

VBA Code:
iLast1 = ws1.Range("A" & Application.Rows.Count).End(xlUp).Row

Set r = ws1.Range("A9:A15000")
For icounter = 1 To iLast1
exists = False
Set f = r.Find(ws1.Range("A" & icounter).Value, , xlValues, xlWhole)
If Not f Is Nothing Then
    Cell = f.Address
    Do
    If ws1.Range("A" & f.Row).Value = ws.Range("AA" & icounter).Value Then
    exists = False
    Exit Do
    End If
    Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> Cell
End If
If exists = True Then
    ws1.Range("L" & icounter).Copy

ws.Range("R" & ws.Range("R" & Application.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteAll
End If

ufProgress.LabelProgress.Width = 0
ufProgress.Show
pctDone = icounter / iLast

With ufProgress
    .LabelCaption.Caption = pctDone * 100 & "% Complete"
    .LabelProgress.Width = pctDone * (.FrameProgress.Width)
End With

DoEvents

Next icounter

Unload ufProgress

Workbooks(Wb2.Name).Close SaveChanges:=False

any help greatly appreciated!!
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of both sheets. Alternately, you could upload copies of your files (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You might have to tweak the workbook and sheet names, but I think this would do what you want.

VBA Code:
Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range, adr As String
Set sh1 = Workbooks("main data.xlsm").Sheets(1) 'edit workbook and sheet names
Set sh2 = Workbooks("new data.xlsx").Sheets(1) 'edit workbook and sheet names
    With sh2
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            Set fn = sh1.Range("AA:AA").Find(c.Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    adr = fn.Address
                    Do
                        sh1.Cells(c.Row, "R") = .Cells(fn.Row, "L").Value
                        Set fn = sh1.Range("AA:AA").FindNext(fn)
                    Loop While fn.Address <> adr
                End If
        Next
    End With
End Sub
 
Solution

si3po

Board Regular
Joined
Jan 7, 2019
Messages
91
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range, adr As String
Set sh1 = Workbooks("main data.xlsm").Sheets(1) 'edit workbook and sheet names
Set sh2 = Workbooks("new data.xlsx").Sheets(1) 'edit workbook and sheet names
    With sh2
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            Set fn = sh1.Range("AA:AA").Find(c.Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    adr = fn.Address
                    Do
                        sh1.Cells(c.Row, "R") = .Cells(fn.Row, "L").Value
                        Set fn = sh1.Range("AA:AA").FindNext(fn)
                    Loop While fn.Address <> adr
                End If
        Next
    End With
End Sub
thanks for this JLGWhiz,

Unfortunately i can't get it to bring the updates across into the matching rows; although it does bring data from WB2 into WB1.

The search/helper value loaded to search from WB2 will not be held in the same row number on WB1, e.g. we could select the search/helper value from WB2 row 137, but the corresponding value on WB1 may be held in row 23.

I can see that your code iterates through all rows in WB1 to look for the value, but then this line:
VBA Code:
sh1.Cells(c.Row, "R") = .Cells(fn.Row, "L").Value
suggests that it pastes the required cell content into WB1, but on the same row as from where the data was taken in WB2; i.e it takes it from, say, row 30 in WB2, finds it in row 79 of WB1, but pastes the cell content from WB2 in row 30 WB1, not row 79 - does that make sense?

if anyone is able to check my workings and correct where possible, it's be much appreciated.
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Yes, I had the c variable and the fn variable reversed. Replacde that line with this:
VBA Code:
sh1.Cells(fn.Row, "R") = .Cells(c.Row, "L").Value
 

si3po

Board Regular
Joined
Jan 7, 2019
Messages
91
Office Version
  1. 365
Platform
  1. Windows
Yes, I had the c variable and the fn variable reversed. Replacde that line with this:
VBA Code:
sh1.Cells(fn.Row, "R") = .Cells(c.Row, "L").Value

Thanks JLG, i figured as much and reversed them myself.

Your code works great and has really helped - i've marked it as the solution.

thanks again (y)(y)!!
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Thanks JLG, i figured as much and reversed them myself.

Your code works great and has really helped - i've marked it as the solution.

thanks again (y)(y)!!
Yoou're welcome,
regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,127,098
Messages
5,622,681
Members
415,920
Latest member
ExcelNoob28

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