Pasting data at end of the data range, ignoring uniques

[DavidGahan]

Hey all,

quick question, if Im having a macro for pasting data from certain sheet (that comes on daily basis) to general sheet and adding multiple data every day to it - I have a formula which is working just fine.

Nevertheless if in that range are data that are already existing, is there a way for the macro to skip these rows? (the ones that entirely match)

my simple macro:

Sub VBA_pasting_at_the_end()
With Sheets("Report")
Range("A2:L1000").Copy
Sheets("Report").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
End Sub

 

[DanteAmor]

Try the following macro, change "sheet1" by the name of your sheet

Sub VBA_pasting_at_the_end_uniques()
    Application.ScreenUpdating = False
    '
    Dim h1 As Worksheet, h2 As Worksheet
    Dim uc As Long, u2 As Long, i As Long
    Dim j As Integer, n As Integer
    Dim cad1 As String
    Dim b As Object
    '
    Set h1 = Sheets("sheet1")  'name of your certain sheet
    Set h2 = Sheets("Report")
    '
    uc = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column + 1
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    '
    For i = 2 To u2
        cad2 = ""
        For j = 1 To Columns("J").Column
            cad2 = cad2 & h2.Cells(i, j).Value
        Next
        h2.Cells(i, uc).Value = cad2
    Next
    '
    n = 0
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row       'check row by row
        cad1 = ""
        For j = 1 To Columns("J").Column
            cad1 = cad1 & h1.Cells(i, j).Value
        Next
        Set b = h2.Columns(uc).Find(cad1, lookat:=xlWhole)
        If b Is Nothing Then
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h1.Rows(i).Copy
            h2.Range("A" & u2).PasteSpecial Paste:=xlPasteValues
            n = n + 1
        End If
    Next
    h2.Columns(uc).Delete
    Application.ScreenUpdating = True
    MsgBox "Added Records : " & n
End Sub

Regards Dante Amor