copy from one WB to another if cell match found

[si3po]

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.

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!!

 

[mumps]

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]

You might have to tweak the workbook and sheet names, but I think this would do what you want.

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

 

[si3po]

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:

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.

 

[JLGWhiz]

Yes, I had the c variable and the fn variable reversed. Replacde that line with this:

sh1.Cells(fn.Row, "R") = .Cells(c.Row, "L").Value

 

[si3po]

Yes, I had the c variable and the fn variable reversed. Replacde that line with this:

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 !!

 

[JLGWhiz]

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 !!

Yoou're welcome,
regards, JLG