Hi Stanley,

Make sure you backup your workbook before running this code because it is
deleting rows and you need to confirm that it is doing what you want it to.
(I have assumed that you want to delete the entire row so if this is not
correct then please get back to me.)

The code inserts a temporary column B to mark the rows to be deleted and
then runs the deletions later and removes the temporary column B.

The code runs on the active sheet so you also need to ensure that the sheet
to be processed is the active sheet before running the code.

Sub RemoveDuplicates()

Dim rngToTest As Range
Dim rngTofind As Range
Dim cel As Range
Dim firstAddress As String
Dim i As Long
Dim rngSave As Range

With ActiveSheet
Set rngToTest = Range(.Cells(2, "A"), _
Cells(.Rows.Count, "A").End(xlUp))
End With

'Insert a temporary column to hold delete flag
Columns("B:B").Insert Shift:=xlToRight

Application.ScreenUpdating = False

For Each rngTofind In rngToTest

'Test if value already searched
If rngTofind.Offset(0, 1) < "Delete" Then
Set cel = Columns("A:A").Find(What:=rngTofind.Value, _
After:=Cells(Rows.Count, "A"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

Set rngSave = Nothing
If Not cel Is Nothing Then 'Found
firstAddress = cel.Address
Set rngSave = cel 'Save the location
Set cel = rngToTest.FindNext(cel)
Do While Not cel Is Nothing And _
cel.Address < firstAddress
cel.Offset(0, 1) = "Delete"
rngSave.Font.Bold = True 'Bold original find
Set cel = rngToTest.FindNext(cel)
Loop
End If
End If
Next rngTofind

With rngToTest
'Work backwards when deleting rows
For i = .Rows.Count To 1 Step -1
If .Cells(i, 1).Offset(0, 1) = "Delete" Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With

'Delete the temporary column
Columns("B:B").Delete
Application.ScreenUpdating = True

End Sub

--
Regards,

OssieMac


"Stanley Braverman" wrote:

I would like to create a macro that would work only on coulomb A. Coulomb A
can contain duplicate names(such as music artists). I would like to clear
the contents of all the duplicate names and then set the original name in
BOLD.
Thanks