{"id":251,"date":"2008-08-19T03:00:22","date_gmt":"2008-08-19T02:00:22","guid":{"rendered":"http:\/\/simoncpage.co.uk\/blog\/?p=251"},"modified":"2008-10-19T14:54:44","modified_gmt":"2008-10-19T13:54:44","slug":"excel-vb-duplicate-range-highlight-and-remove","status":"publish","type":"post","link":"https:\/\/simoncpage.co.uk\/blog\/2008\/08\/excel-vb-duplicate-range-highlight-and-remove\/","title":{"rendered":"Excel VB | duplicate range highlight and remove"},"content":{"rendered":"

This post is a follow up to the unique random numbers post – I have included a Remove Duplicates from Range function, in the workbook here<\/a>,\u00a0so that you can check the list it creates. This function below will remove the first duplicate in a range that you select.<\/p>\n

Sub RemoveFirstDuplicates()<\/p>\n

Dim rConstRange As Range, rFormRange As Range
\nDim rAllRange As Range, rCell As Range
\nDim iCount As Long
\nDim strAdd As String<\/p>\n

On Error Resume Next
\nSet rAllRange = Selection
\nIf WorksheetFunction.CountA(rAllRange) < 2 Then
\nMsgBox “You selection is not valid”, vbInformation
\nOn Error GoTo 0
\nExit Sub
\nEnd If
\nSet rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)
\nSet rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)
\nIf Not rConstRange Is Nothing And Not rFormRange Is Nothing Then
\nSet rAllRange = Union(rConstRange, rFormRange)
\nElseIf Not rConstRange Is Nothing Then
\nSet rAllRange = rConstRange
\nElseIf Not rFormRange Is Nothing Then
\nSet rAllRange = rFormRange<\/p>\n

Else
\nMsgBox “You selection is not valid”, vbInformation
\nOn Error GoTo 0
\nExit Sub
\nEnd If<\/p>\n

Application.Calculation = xlCalculationManual<\/p>\n

For Each rCell In rAllRange
\nstrAdd = rCell.Address
\nstrAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Address<\/p>\n

If strAdd <> rCell.Address Then
\nrCell.Clear
\nEnd If<\/p>\n

Next rCell<\/p>\n

Application.Calculation = xlCalculationAutomatic
\nOn Error GoTo 0<\/p>\n

End Sub<\/p><\/blockquote>\n

This is another duplicate function – this one will count the duplicates and also highlight them in green (this was not included in download).<\/p>\n

Sub CountNumberOfDuplicates()<\/p>\n

On Error GoTo ENDER
\nApplication.ScreenUpdating = False<\/p>\n

If Selection.Columns.Count * Selection.Rows.Count = 1 Then
\nMsgBox “Select more then one cell.”, vbExclamation
\nExit Sub
\nEnd If<\/p>\n

SetColourIndex = 4<\/p>\n

i = Selection.Cells.Count
\nn = 0
\nk = 0<\/p>\n

For Each MyCell In Selection<\/p>\n

CellCount = MyCell.Value
\nIf MyCell.Value = “” Then
\nElse<\/p>\n

If Application.WorksheetFunction.CountIf(Selection, CellCount) > 1 Then<\/p>\n

k = k + 1
\nn = n + 1
\nMyCell.Interior.ColorIndex = SetColourIndex<\/p>\n

End If<\/p>\n

End If<\/p>\n

Percentage = n \/ i * 100<\/p>\n

Next<\/p>\n

Application.StatusBar = False
\nApplication.ScreenUpdating = True<\/p>\n

MsgBox “Selection contains ” & k & ” duplicate values.”, vbInformation
\nExit Sub
\nENDER:
\nApplication.StatusBar = False
\nApplication.ScreenUpdating = True<\/p>\n

End Sub<\/p><\/blockquote>\n","protected":false},"excerpt":{"rendered":"

This post is a follow up to the unique random numbers post – I have included a Remove Duplicates from Range function, in the workbook here,\u00a0so that you can check the list it creates. This function below will remove the first duplicate in a range that you select. Sub RemoveFirstDuplicates() Dim rConstRange As Range, rFormRange […]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"_monsterinsights_skip_tracking":false,"_monsterinsights_sitenote_active":false,"_monsterinsights_sitenote_note":"","_monsterinsights_sitenote_category":0},"categories":[26],"tags":[123,79,78,117,27,119,121],"aioseo_notices":[],"_links":{"self":[{"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/posts\/251"}],"collection":[{"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/comments?post=251"}],"version-history":[{"count":0,"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/posts\/251\/revisions"}],"wp:attachment":[{"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/media?parent=251"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/categories?post=251"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/simoncpage.co.uk\/blog\/wp-json\/wp\/v2\/tags?post=251"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}