Compare cells in rows from 2 differents sheets before copy

[cocolasticot50]

Hi everyone !

first of all thank you for all your posts.
It is my first query on this forum but I've already read some very interesting things !

Here is my problem. I'm having a hard time figuring out how to do the following, and I'm wondering if you could help out.

I have a worksheet with two differents sheets which have the same columns and I want to copy the rows from sheet 2 to sheet 1 but first, I need to check sheet 1 to make sure it doesn't already contain the rows (based on Cells Ato H) then I need to find the first empty row on sheet 1 and finally copy from sheet 2 the rows that don't already exists onto sheet 1.

Any idea how this could be achieved ?

Thanks a lot in advance for any help you can provide

 

[RaulARodriguez]

Thanks again !

I now get this error : method Range of object '_Worksheet' failed

=> Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp)).Row) ' New area from unique rows are copied. (Check the range)

Did you Try my approach?

 

[RaulARodriguez]

Sub CopyFltrdRows()
Dim Srcwks As Worksheet
Dim Tgtwks As Worksheet
Dim SrcRng As Range
Dim TgtRng As Range
Dim iSrcLR As Integer
Dim iTgtLR As Integer


Set Srcwks = ThisWorkbook.Worksheets("Sheet2")
Set Tgtwks = ThisWorkbook.Worksheets("Sheet1")



iSrcLR = Srcwks.Range("J" & Rows.Count).End(xlUp).Row
iTgtLR = Tgtwks.Range("I" & Rows.Count).End(xlUp).Row
   
    
     With Srcwks
        If .AutoFilterMode = False Then
            .Columns("J:J").AutoFilter
        End If
        .Range("J:J").AutoFilter Field:=1, Criteria1:="#N/A"
        .Range("A2:I" & iSrcLR).SpecialCells(xlCellTypeVisible).Copy Destination:=Tgtwks.Range("A" & iTgtLR)
       
        Application.CutCopyMode = False
   
     End With
   
End Sub

 

[Tupe77]

Thanks again !

I now get this error : method Range of object '_Worksheet' failed

=> Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp)).Row) ' New area from unique rows are copied. (Check the range)

For some reason I can't find that error now, but I changed the range creation to match the one that already works.
Hope that helped?

Sub TS_checkrows()
Dim wsOD As Worksheet: Set wsOD = Worksheets("Sheet1")
Dim wsND As Worksheet: Set wsND = Worksheets("Sheet2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long: lastRow = wsOD.Range("A" & wsOD.Cells(wsOD.Rows.Count, "A").End(xlUp).Row).Row
Dim lastRowND As Long: lastRowND = wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp).Row).Row
Dim OldDataRNG As Range: Set OldDataRNG = wsOD.Range("A2:H" & lastRow) ' The old area with the data to be stored (Check the range)
Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & lastRowND) ' New area from unique rows are copied. (Check the range)
Dim NewDataRow As Range: Set NewDataRow = wsOD.Range("A" & lastRow & ":H" & lastRow)
Dim TempRowSTR As String
Dim TmpRow As Variant
Dim iC As Variant

For Each TmpRow In OldDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
    dict(TempRowSTR) = TmpRow.Row
Next TmpRow

Dim i As Long
For Each TmpRow In NewDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
        If dict.exists(TempRowSTR) Then
            ' nothing
        Else
            i = i + 1
            NewDataRow.Offset(i, 0).Value = TmpRow.Value
        End If
Next TmpRow

End Sub

 

[Tupe77]

For some reason I can't find that error now, but I changed the range creation to match the one that already works.
Hope that helped?

Sub TS_checkrows()
Dim wsOD As Worksheet: Set wsOD = Worksheets("Sheet1")
Dim wsND As Worksheet: Set wsND = Worksheets("Sheet2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long: lastRow = wsOD.Range("A" & wsOD.Cells(wsOD.Rows.Count, "A").End(xlUp).Row).Row
Dim lastRowND As Long: lastRowND = wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp).Row).Row
Dim OldDataRNG As Range: Set OldDataRNG = wsOD.Range("A2:H" & lastRow) ' The old area with the data to be stored (Check the range)
Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & lastRowND) ' New area from unique rows are copied. (Check the range)
Dim NewDataRow As Range: Set NewDataRow = wsOD.Range("A" & lastRow & ":H" & lastRow)
Dim TempRowSTR As String
Dim TmpRow As Variant
Dim iC As Variant

For Each TmpRow In OldDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
    dict(TempRowSTR) = TmpRow.Row
Next TmpRow

Dim i As Long
For Each TmpRow In NewDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
        If dict.exists(TempRowSTR) Then
            ' nothing
        Else
            i = i + 1
            NewDataRow.Offset(i, 0).Value = TmpRow.Value
        End If
Next TmpRow

End Sub

I found my mistake, but it's already fixed in the previous version.
The mistake was obvious, but I'm just too blind... Copy paste is too fast for me, so half the line was copied twice.

Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp)).Row)

Of course, the row must be:

Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Cells(Rows.Count, "A").End(xlUp).Row)

 

[cocolasticot50]

Thanks a lot ! it's working great.
I should have said though that while I want to compare rows with A to H; I want to copy it all from A to Q...
Any chance you could help out ?
Thanks !

 

[Tupe77]

After a quick test, I think this works from A to Q...

Sub TS_checkrows2()
Dim wsOD As Worksheet: Set wsOD = Worksheets("Sheet1")
Dim wsND As Worksheet: Set wsND = Worksheets("Sheet2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long: lastRow = wsOD.Range("A" & wsOD.Cells(wsOD.Rows.Count, "A").End(xlUp).Row).Row
Dim lastRowND As Long: lastRowND = wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp).Row).Row
Dim OldDataRNG As Range: Set OldDataRNG = wsOD.Range("A2:H" & lastRow) ' The old area with the data to be stored (Check the range)
Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & lastRowND) ' New area from unique rows are copied. (Check the range)
Dim NewDataRow As Range: Set NewDataRow = wsOD.Range("A" & lastRow & ":H" & lastRow)
Dim TempRowSTR As String
Dim TmpRow As Variant
Dim iC As Variant

For Each TmpRow In OldDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
    dict(TempRowSTR) = TmpRow.Row
Next TmpRow

Dim i As Long
For Each TmpRow In NewDataRNG.Rows
    TempRowSTR = ""
    For Each iC In TmpRow.Cells
        TempRowSTR = TempRowSTR & iC.Value
    Next iC
        If dict.exists(TempRowSTR) Then
            ' nothing
        Else
            i = i + 1
            NewDataRow.Resize(1, 17).Offset(i, 0).Value = TmpRow.Resize(1, 17).Value
        End If
Next TmpRow

End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."