Copy unique line based on cell value

VbaHell

Well-known Member
Joined
Jan 30, 2011
Messages
1,206
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
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

KennyGreens

Board Regular
Joined
Aug 8, 2018
Messages
142
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,650
Office Version
  1. 365
Platform
  1. Windows
Maybe
Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,650
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,522
Messages
5,529,329
Members
409,863
Latest member
stacy09
Top