Microsoft Office Tutorials and References
In Depth Information
Highlighting Duplicates Within a Range
View the Appendix to learn how to store this procedure
in a Standard module.
Option Explicit¶
' * * * * *¶
Sub HighlightDuplicates()¶
'Highlights any duplicate entries that appear within a contiguous range
(not only a column)¶
'Variable declarations¶
Dim Rng As Range¶
Dim Formula As String¶
'Check if a worksheet is selected¶
If TypeName(ActiveSheet) <> "Worksheet" Then¶
MsgBox "There must be at least one worksheet visible", _¶
vbCritical¶
Exit Sub¶
End If¶
'Change the following variables¶
'use the following line for a constant range - change as required¶
Set Rng = Range("A1:A13")¶
'Comment out the line above (add an apostrophe at left)¶
'and remove the apostrophe on the line below to use the¶
'selected range¶
' Set Rng = ActiveWindow.RangeSelection¶
'Can only do on contigous ranges¶
If Rng.Areas.Count > 1 Then¶
MsgBox "Unable to work on non contiguous cells", vbCritical¶
Else¶
'Delete any conditional formats¶
Rng.FormatConditions.Delete¶
'Create the formula¶
Formula = "=COUNTIF(" & Rng.Address(True, True, xlR1C1) & ","¶
If Rng.Columns.Count > 1 Then¶
Formula = Formula & ActiveCell.Address(False, False, _¶
xlR1C1) & ")>1"¶
Else¶
Formula = Formula & ActiveCell.Address(False, True, _¶
xlR1C1) & ")>1"¶
End If¶
'Make sure that the correct position is used¶
Formula = Application.ConvertFormula(Formula, xlR1C1, xlA1, , _¶
Range("A1"))¶
'Add the new condition¶
With Rng.FormatConditions.Add(xlExpression, , Formula)¶
.Interior.ColorIndex = 38 'Light red¶
End With¶
End If¶
End Sub¶
Exl
Search JabSto ::




Custom Search