Home > OS >  Compare data between 2 sheets and move data to sheet3
Compare data between 2 sheets and move data to sheet3

Time:02-01

I'm looking for a solution for my case. Right now i have a file with 3 sheets where i have data in 2 sheets. In first sheet "sheet1", i have raw data with many rows (~10k rows of data) and 10 columns (A:J), in second sheet "sheet2" (~1k-8krows of data) i have the same 10 columns like "sheet1" (A:J) with data only on column "C". The code i used is:

Option Explicit
Sub CopyDuplicates()
    MsgBox "Procesul a inceput. Daca nu se regasesc date in 'Sheet3', " & _
           "inseamna ca datele din coloana 'C - Sheet2' nu se regasesc in 'Sheet1'"
    
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lr1 As Long, lr2 As Long, r As Long, r3 As Long
    Dim ar As Variant, i As Long
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    Set ws3 = Sheets("Sheet3")
    ws3.Cells.Clear

    lr1 = ws1.UsedRange.Rows.Count
    lr2 = ws2.UsedRange.Rows.Count
    ws1.UsedRange.Interior.ColorIndex = xlNone
    ws2.UsedRange.Interior.ColorIndex = xlNone

    ' dictionar sheet2 coloana C
    Dim dict, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    For r = 1 To lr2
        key = Trim(ws2.Cells(r, "C"))
        If Len(key) > 0 Then
            If dict.exists(key) Then
                dict(key) = dict(key) & ";" & r
            Else
                dict.Add key, r
            End If
        End If
    Next

    Application.ScreenUpdating = False
    r3 = 1 ' Sheet3
    ' scaneaza datele din Sheet1 daca se regasesc in Sheet2
    For r = 1 To lr1
        key = Trim(ws1.Cells(r, "C"))
        If dict.exists(key) Then
            ' functie copiere/stergere - datele regasite in urma scanarii le copiaza in Sheet3 urmand a fi sterse din Sheet1
            ar = Split(dict(key), ";")
            For i = LBound(ar) To UBound(ar)
                ws1.Range("A" & r).Resize(1, 10).Copy ws3.Range("A" & r3) ' A:J
                ws1.Range("A" & r).Rows.Delete
                r3 = r3   1
            Next
        End If
    Next
   
    Application.ScreenUpdating = True
    MsgBox "Proces finalizat cu succes."
End Sub

My script compare data from "sheet1" to data inserted in column "C" from "sheet2" and if match, copy rows in "sheet3" from "sheet1" then delete the rows matched from "sheet1" first row (table header). How can i skip the first row (table header) from delete function on "sheet1?

Edit: I added screenshots with "sheet1" and "sheet2" sheet1 sheet2

CodePudding user response:

I guess it would be enough to start the code in row2

So instead of For r = 1 To lr1 put For r = 2 To lr1

  •  Tags:  
  • Related