[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]Const sRow As Long = 1 [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' source start row[/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New]Const sColumn As Long = 3 '[COLOR=green] source column - 3=C[/COLOR][/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Const tColumn As Long = 4 [COLOR=green]' target column - 4=D[/COLOR][/FONT][/SIZE]
[FONT=Courier New][SIZE=1]Public Sub CopyUnique()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]Dim arr() As String[/SIZE][/FONT]
[SIZE=1][FONT=Courier New]Dim iLastRow As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim jPtr As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim kPtr As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim sTemp As String[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Columns(tColumn).ClearContents[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]iLastRow = Cells(Rows.Count, sColumn).End(xlUp).Row[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]ReDim arr(iLastRow) As String[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]For jPtr = 1 To iLastRow[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] arr(jPtr) = Cells(jPtr, sColumn)[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next jPtr[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]For jPtr = sRow To iLastRow - 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] For kPtr = jPtr + 1 To iLastRow[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] If arr(jPtr) = arr(kPtr) Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] arr(kPtr) = ""[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] ElseIf arr(jPtr) > arr(kPtr) Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] sTemp = arr(jPtr)[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] arr(jPtr) = arr(kPtr)[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] arr(kPtr) = sTemp[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] End If[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] Next kPtr[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next jPtr[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]jPtr = sRow - 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]For kPtr = sRow To iLastRow[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] If arr(kPtr) <> "" Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] jPtr = jPtr + 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] Cells(jPtr, tColumn) = arr(kPtr)[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] End If[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next kPtr[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]MsgBox CStr(iLastRow - sRow) & " rows processed" & Space(10) & vbCrLf & vbCrLf _[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] & CStr(jPtr - sRow) & " unique rows extracted", vbOkOnly + vbInformation[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]End Sub[/FONT][/SIZE]