CODEWITHSUNDEEP
vbaexcelduplicatesconditional-formatting
nightcrawler
nightcrawler

Reputation: 327

Highlight Duplicates in a single Range

Assuming Range is contiguous & is a single column.

I want to highlight duplicate entries for the above RANGE. My VBA is as follows but is not functioning as is intended. The theme is to compare say first cell value to its bottom value using OFFSET

Sub CompareSingleRange()
Dim rangeToUse1 As Range, rangeToUse2 As Range, cell1 As Range, cell2 As Range
' Assume Selection is contiguous
Set rangeToUse1 = Selection
Set rangeToUse2 = Selection
    For Each cell1 In rangeToUse1
        For Each cell2 In rangeToUse2
           If cell1.Value = cell2.Offset(1,0).Value Then
            cell1.Interior.ColorIndex = 38
            End If
        Next cell2
    Next cell1
End Sub

Upvotes: 1

Views: 177

Answers (3)

user4039065
user4039065

Reputation:

Try a conditional formatting rule. Code it if it seems easier.

With Worksheets("Sheet1")
    With .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        With .FormatConditions(1)
            .Interior.Color = vbGreen
        End With
    End With
End With

            cf_duplicates

Upvotes: 2

Alexander Bell
Alexander Bell

Reputation: 7918

You may use Excel Worksheet Functions in order to complete this task; otherwise, the "pure" VBA solution is shown below (you just need to slightly modify your original Sub with additional condition):

Sub FindDuplicates()
    Dim rangeToUse1 As Range, cell1 As Range, cell2 As Range
    Set rangeToUse1 = Selection
    For Each cell1 In rangeToUse1
        For Each cell2 In rangeToUse1
           If cell1.Value = cell2.Value And cell1.Row <> cell2.Row Then
              cell1.Interior.ColorIndex = 38
           End If
        Next cell2
    Next cell1
End Sub

Hope this will help.

Upvotes: 1

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

You only need a single loop:

Sub CompareSingleRange()
    Dim rangeToUse1 As Range, cell1 As Range
    Dim wf As WorksheetFunction
    Set wf = Application.WorksheetFunction
    ' Assume Selection is contiguous
    Set rangeToUse1 = Selection

        For Each cell1 In rangeToUse1
                If wf.CountIf(rangeToUse1, cell1) > 1 Then
                    cell1.Interior.ColorIndex = 38
                End If
        Next cell1
End Sub

enter image description here

Upvotes: 1

Related Questions