Copy unique line based on cell value

[VbaHell]

Hello all

I hope you can help on this please

Sheet1 has a unique key in column "L"
Sheet1 also has a status in column "H" with options of "A" or "C"
Sheet2 has the same unique key in Column "J"

What I want to do is starting from Row 7

Sheet1 = If "H" = "A" then copy this row to sheet2 but only copy if it's not a duplicate unique key

any help would be great please

 

[KennyGreens]

Hi there, so basically starting at the next blank row in sheet 2, you'd like to copy rows from sheet 1 if column H in that row = "A" and if column L in that row is not already in any rows in column J in sheet 2?

 

[Fluff]

Maybe

Sub VbaHell()
   Dim Cl As Range, Rng As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet2")
      For Each Cl In .Range("J2", .Range("J" & Rows.count).End(xlUp))
         Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Sheet1")
      For Each Cl In .Range("L7", .Range("L" & Rows.count).End(xlUp))
         If Not Dic.Exists(Cl.Value) And Cl.Offset(, -4).Value = "A" Then
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then
      Rng.EntireRow.Copy Sheets("Sheet2").Range("J" & Rows.count).End(xlUp).Offset(1, -9)
   End If
End Sub

 

[VbaHell]

Hi Kenny

Yes that is correct

 

[VbaHell]

Fluff thank you very much, just what I needed

 

[Fluff]

You're welcome & thanks for the feedback