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]

Try this:

• In both sheets in column i concatenate all cells in a row from column A to column H
• In Sheet2 column J, place a vlookup formula -> =VLOOKUP(I2,Sheet1!$I:$I,1,FALSE)
• If Sheet2 column J has a #N/A as a result, that would be the row you want to copy
• You can then place a filter on this error and it will leave only all of those rows you want to copy from Sheet2 into Sheet1
• Write a code to automate

 

[cocolasticot50]

Thank you ! I forgot to mention that I need it all in VBA

 

[Tupe77]

Do you mean something like this?

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(Rows.Count, "A").End(xlUp)).Row
Dim OldDataRNG As Range: Set OldDataRNG = wsOD.Range("A2:H" & LastRow)
Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Range("A" & wsND.Cells(Rows.Count, "A").End(xlUp)).Row)
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

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

 

[RaulARodriguez]

I meant something linke this:

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

 

[RaulARodriguez]

Empty

 

[cocolasticot50]

I meant something linke this:

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

I get an error on

I meant something linke this:

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

Do you mean something like this?

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(Rows.Count, "A").End(xlUp)).Row
Dim OldDataRNG As Range: Set OldDataRNG = wsOD.Range("A2:H" & LastRow)
Dim NewDataRNG As Range: Set NewDataRNG = wsND.Range("A2:H" & wsND.Range("A" & wsND.Cells(Rows.Count, "A").End(xlUp)).Row)
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

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

Thank you for your reply !

I get an error on line : Dim LastRow As Long: LastRow = wsOD.Range("A" & wsOD.Cells(Rows.Count, "A").End(xlUp)).Row
=> Range failed

 

[Tupe77]

Do you have the corresponding sheets in your workbook?
Change the names if necessary.

Dim wsOD As Worksheet: Set wsOD = Worksheets("Sheet1")
Dim wsND As Worksheet: Set wsND = Worksheets("Sheet2")

 

[Tupe77]

At least one row calculation sheet was undefined. My apologies.

On both sheets, data is read from cell A2 to H(lastrow)
Is Column and Row correct?

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 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" & wsND.Range("A" & wsND.Cells(wsND.Rows.Count, "A").End(xlUp)).Row) ' 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

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

 

[cocolasticot50]

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)