Sub HighlightDuplicateLinks()
'Takes URL's in Column A, sorts and highlights duplicate values.
Dim dialogBox
Dim finishBox
dialogBox = MsgBox("Look for Duplicate Values in Column A?" & _
vbNewLine & vbNewLine & "Written by Joshua Snow" & _
vbNewLine & "jsnow.pageonepower@gmail.com", vbOKCancel, "Look for Duplicates")
If dialogBox = vbCancel Then
Exit Sub
End If
Dim lastRow As Long
Dim duplicateFound As Long
Dim i As Long
Dim myWB As Workbook
Set myWB = ActiveWorkbook
Dim ws As Worksheet
Set ws = myWB.ActiveSheet
Dim cell As Range
ws.Range("A1").EntireRow.Insert
ws.Range("A1").Value = "URL List"
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 1) <> "" Then
duplicateFound = WorksheetFunction.Match(Cells(i, 1), Range _
("A1:A" & lastRow), 0)
If i <> duplicateFound Then
Cells(i, 1).Interior.Color = rgbYellow
End If
End If
Next
AutoFilterMode = False
Range("A1").AutoFilter
With ws
.AutoFilter.Sort.SortFields.Add(Range _
("A:A"), xlSortOnCellColor, xlAscending, xlSortNormal) _
.SortOnValue.Color = rgbYellow
.AutoFilter.Sort.Header = xlYes
.AutoFilter.Sort.MatchCase = False
.AutoFilter.Sort.Orientation = xlTopToBottom
.AutoFilter.Sort.SortMethod = xlPinYin
.AutoFilter.Sort.Apply
.Columns("A:A").ColumnWidth = 50 'for aesthetics
.Range("A1").Select
End With
For Each cell In Range("A:A")
If cell.Interior.Color = Excel.XlRgbColor.rgbYellow Then
cell.Value = "http://www." & cell.Value
ws.Hyperlinks.Add Anchor:=cell, Address:=cell.Formula
End If
Next cell
finishBox = MsgBox("Finished!" & vbNewLine & vbNewLine _
& "Duplicate URL's are at the top of the list.", _
vbOKOnly, "Finished")
If finishBox = vbokay Then
Exit Sub
End If
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (1)
Commented: