Looping update

[VegasNath]

Hello,
I'm having difficulty trying to get this to work as expected and would appreciate some help. Apologies but I am unable to upload a file at the moment :(
I have 3 worksheets, SAP, Oracle (both source data) and Combined (required destination).
The source data sheets have YTD transactions, some of which will already be present in the Combined sheet.
What I am attempting to do is set the range of the combined sheet as a look up range, and then loop through each transaction in the source sheets and copy each line to the Combined sheet where the data is not yet present.
Column I details the document ID, each document can have 1 to an unlimited amount of transactions (rows). A partial document could never end up in the combined sheet.
I think my logic works here, but I am only getting the first transaction from each document copied to the combined sheet, so clearly it doesn't.
My vba is a little rusty!
 

Code: Select all

'Identify last used row in Combined data
i = Worksheets("Combined").Range("O15").End(xlDown).Row
 
'Update to Old
Worksheets("Combined").Range("P15:P" & i).Value = "Old"
 
'Set search range
Set SrchRng = Worksheets("Combined").Range("O15:O" & i)
 
'SAP
x = Worksheets("SAP").Range("O6").End(xlDown).Row
Set FindRng = Worksheets("SAP").Range("O7:O" & x)
 
For Each Rng In FindRng
    Set Result = Cells.find(What:=Rng, After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False, SearchFormat:=False)
 
    If Result Is Nothing Then
        y = Rng.Row
        Z = Worksheets("Combined").Range("O15").End(xlDown).Row + 1
        Worksheets("SAP").Range("A" & y & ":O" & y).Copy
        Worksheets("Combined").Range("A" & Z).PasteSpecial xlPasteValues
        Worksheets("Combined").Range("P" & Z) = "New"
    End If
Next Rng
 
'Oracle
x = Worksheets("Oracle").Range("O6").End(xlDown).Row
Set FindRng = Worksheets("Oracle").Range("O7:O" & x)
 
For Each Rng In FindRng
    Set Result = Cells.find(What:=Rng, After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False, SearchFormat:=False)
 
    If Result Is Nothing Then
        y = Rng.Row
        Z = Worksheets("Combined").Range("O15").End(xlDown).Row + 1
        Worksheets("Oracle").Range("A" & y & ":O" & y).Copy
        Worksheets("Combined").Range("A" & Z).PasteSpecial xlPasteValues
        Worksheets("Combined").Range("P" & Z) = "New"
    End If
Next Rng

[Rudi]

First thing I'd change is Activecell in the Find statement to something like: FindRng.Cells(1), unless activecell is located to the correct position before the time...

eg: Set Result = Cells.find(What:=Rng, After:=FindRng.Cells(1), LookIn:= _

[VegasNath]

Thanks Rudi, not sure how I ended up using ActiveCell, I usually avoid that! Changed as suggested, but the result is the same :(

[HansV]

You search in Cells on the Combined sheet, so you'll find the already copied row(s). To avoid that, search in SrchRng only.
The following version uses a loop to avoid duplicating the code for SAP and Oracle:

Code: Select all

    Dim wshC As Worksheet
    Dim wshS As Worksheet
    Dim wshO As Worksheet
    Dim i As Long
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim SrchRng As Range
    Dim FindRng As Range
    Dim Rng As Range
    Dim Result As Range

    Set wshC = Worksheets("Combined")
    Set wshS = Worksheets("SAP")
    Set wshO = Worksheets("Oracle")

    'Identify last used row in Combined data
    i = wshC.Range("O15").End(xlDown).Row
 
    'Update to Old
    wshC.Range("P15:P" & i).Value = "Old"
 
    'Set search range
    Set SrchRng = wshC.Range("O15:O" & i)
 
    For Each wshS In Worksheets(Array("SAP", "Oracle"))
        x = wshS.Range("O6").End(xlDown).Row
        Set FindRng = wshS.Range("O7:O" & x)
 
        For Each Rng In FindRng
            Set Result = SrchRng.Find(What:=Rng.Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
 
            If Result Is Nothing Then
                y = Rng.Row
                z = wshC.Range("O15").End(xlDown).Row + 1
                wshS.Range("A" & y & ":O" & y).Copy
                wshC.Range("A" & z).PasteSpecial xlPasteValues
                wshC.Range("P" & z) = "New"
            End If
        Next Rng
    Next wshS

[VegasNath]

Great, thanks Hans, does the job perfectly.