Remove Duplicates and Replace Content Cell

[zonorox]

Hi guys, i need help to build a macro that will help me to find the duplicates in a column, remove the first duplicate and replace the cell.

In easy words, if i have the column like this:


Marco
Marco
Michele
Francesco

I would like to have

N/A
Marco
Michele
Francesco

In this way i don't have dupicates anymore.


Can someone help me please?

[Benzadeus]

Sub Main()
Const TEST_COL = "A"

Dim iRow As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim Values As Object 'Scripting.Dictionary
Dim iValue As String

Set Values = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
LastRow = ws.Cells(ws.Rows.Count, TEST_COL).End(xlUp).Row

'Considering one header row
For iRow = LastRow To 2 Step -1
'Ignore Errors
If IsError(ws.Cells(iRow, TEST_COL)) = False Then
iValue = ws.Cells(iRow, TEST_COL)
'Ignoring blank rows
If iValue <> "" Then
If Values.Exists(iValue) Then
ws.Cells(iRow, TEST_COL) = CVErr(xlErrNA)
Else
Values.Add iValue, iValue
End If
End If
End If
Next iRow
End Sub

[zonorox]

Sub Main()
Const TEST_COL = "A"

Dim iRow As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim Values As Object 'Scripting.Dictionary
Dim iValue As String

Set Values = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
LastRow = ws.Cells(ws.Rows.Count, TEST_COL).End(xlUp).Row

'Considering one header row
For iRow = LastRow To 2 Step -1
'Ignore Errors
If IsError(ws.Cells(iRow, TEST_COL)) = False Then
iValue = ws.Cells(iRow, TEST_COL)
'Ignoring blank rows
If iValue <> "" Then
If Values.Exists(iValue) Then
ws.Cells(iRow, TEST_COL) = CVErr(xlErrNA)
Else
Values.Add iValue, iValue
End If
End If
End If
Next iRow
End Sub



Hi, many thanks for helping me.

The macro seems that doesn't work, i have the first line Sub Main() Const TEST_COL = "A" in red.


Thanks

[Benzadeus]

Break the line. Put Sub Main() in the first line and Const TEST_COL = "A" in the second line.