Copy data from one sheet to another sheet ignoring the duplicate at destination sheet

[thespardian]

Hi there!
On Sheet6 (D Data), The range K3:K50 have an array formula for the extraction of unique Centre list. And I want to copy the only cells that contain text. (range K3:K9 in the given example)......... And

paste it at the end of column B on Sheet 7 (Compile D) by ignoring the names already available in the existing list at destination sheet (i.e Sheet 7 (Compile D))

I mean, duplicate names are not required and the order of list should not be disturbed on Sheet7(Compile D).
Any help on the matter would be highly appreciated. TIA

 

[Zot]

Try this

Sub CompileD()

Dim nRow As Long
Dim key As Variant
Dim cell As Range, rngUnique As Range
Dim rngComp As Range, rngFound As Range
Dim wsData As Worksheet, wsComp As Worksheet
Dim DictData As Object

Set DictData = CreateObject("Scripting.Dictionary")
Set wsData = ActiveWorkbook.Sheets("D Data")
Set wsComp = ActiveWorkbook.Sheets("Compiled D")
Set rngUnique = wsData.Range("K3", "K50")

Application.ScreenUpdating = False

For Each cell In rngUnique
    If Not cell = "" Then
        DictData.Add cell.Value, Nothing
    Else
        Exit For
    End If
Next

nRow = wsComp.Cells(Rows.Count, "C").End(xlUp).Row
If Not nRow = 3 Then
    Set rngComp = wsComp.Range("C3", "C" & nRow)
End If

For Each key In DictData.keys
    Set rngFound = rngComp.Find(What:=key, LookAt:=xlWhole)
    If rngFound Is Nothing Then
        nRow = nRow + 1
        wsComp.Range("C" & nRow) = key
    End If
Next
Application.ScreenUpdating = True
    
End Sub

 

[thespardian]

Try this

Sub CompileD()

Dim nRow As Long
Dim key As Variant
Dim cell As Range, rngUnique As Range
Dim rngComp As Range, rngFound As Range
Dim wsData As Worksheet, wsComp As Worksheet
Dim DictData As Object

Set DictData = CreateObject("Scripting.Dictionary")
Set wsData = ActiveWorkbook.Sheets("D Data")
Set wsComp = ActiveWorkbook.Sheets("Compiled D")
Set rngUnique = wsData.Range("K3", "K50")

Application.ScreenUpdating = False

For Each cell In rngUnique
    If Not cell = "" Then
        DictData.Add cell.Value, Nothing
    Else
        Exit For
    End If
Next

nRow = wsComp.Cells(Rows.Count, "B").End(xlUp).Row
If Not nRow = 3 Then
    Set rngComp = wsComp.Range("B3", "B" & nRow)
End If

For Each key In DictData.keys
    Set rngFound = rngComp.Find(What:=key, LookAt:=xlWhole)
    If rngFound Is Nothing Then
        nRow = nRow + 1
        wsComp.Range("B" & nRow) = key
    End If
Next
Application.ScreenUpdating = True
    
End Sub

Thanks a lot for your guidance. I just changed the Column name (B instead of C) and its working very well.

 

[Zot]

Thanks for updating