'Object Required' error in macro for finding duplicate using ListObjects

[AskMyDog]

Hi,

I am trying to write a macro which highlights the second, and all following duplicates, in a table using ListObjects

Unfortunately, it keeps returning an 'Object Required' error when arriving at the "countif" function. In the debug mode, the variable "Dupl_Cell" has a value when I hover over it, so maybe it's the variable "Name_Col"?

Here's the code:

Sub Highlight_Duplicates()

Dim lotarget As ListObject
Dim Name_Col, Dupl_Rng As Range
Dim Dupl_cell As Variant
Dim TableRows As Long
Dim First_Dupl As String


Set lotarget = Worksheets("Reconcile Meds Here").ListObjects("Table3")

TableRows = lotarget.ListRows.Count
Name_Col = lotarget.Range.Columns(1)


    
        For Each Dupl_cell In Name_Col
            If WorksheetFunction.CountIf(Name_Col, Dupl_cell.Value) > 1 Then
                Set Dupl_Rng = Rng.Find(What:=Dupl_cell.Value, LookIn:=xlValues)
                If Not Dupl_Rng Is Nothing Then
                    First_Dupl = Dupl_cell.Address
                    Do
                        Set Dupl_cell = Rng.FindNext(Dupl_cell)
                        Dupl_cell.Interior.ColorIndex = 35
                    Loop While Not Dupl_cell Is Nothing And Dupl_cell.Address <> First_Dupl
                End If
            End If
        Next

End Sub

Thanks for helping. VBA drives me NUTS!

Steve

 

[RoryA]

Either remove the .Value from Dupl_cell.Value or use Range objects with Set:

Sub Highlight_Duplicates()

Dim lotarget As ListObject
Dim Name_Col As Range, Dupl_Rng As Range
Dim Dupl_cell As Range
Dim TableRows As Long
Dim First_Dupl As String


Set lotarget = Worksheets("Reconcile Meds Here").ListObjects("Table3")

TableRows = lotarget.ListRows.Count
Set Name_Col = lotarget.Range.Columns(1)


    
        For Each Dupl_cell In Name_Col.Cells
            If WorksheetFunction.CountIf(Name_Col, Dupl_cell.Value) > 1 Then
                Set Dupl_Rng = Rng.Find(What:=Dupl_cell.Value, LookIn:=xlValues)
                If Not Dupl_Rng Is Nothing Then
                    First_Dupl = Dupl_cell.Address
                    Do
                        Set Dupl_cell = Rng.FindNext(Dupl_cell)
                        Dupl_cell.Interior.ColorIndex = 35
                    Loop While Not Dupl_cell Is Nothing And Dupl_cell.Address <> First_Dupl
                End If
            End If
        Next

End Sub

As an aside, note that this:

Dim Name_Col, Dupl_Rng As Range

declares Name_Col as Variant and Dupl_Range as Range. To declare both as Range you must specify the type for both:

Dim Name_Col As Range, Dupl_Rng As Range

 

[Sektor]

You can use conditional formatting. Click here to download book with example. It has Table with some dummy data. Press "Highlight First Unique" button to see the result.
Here's macro to do it. Adopt this code to your needs.

Sub HighlightFirstUnique()
    Dim lo As ListObject
    Set lo = ActiveSheet.ListObjects(1) 'Our list object (table)
    With lo.DataBodyRange.Columns(1)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(E$2:E2;E2)>1"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub

 

[AskMyDog]

Thanks Rory!

That worked.

VBA is so confusing! Then again, I am NOT a programmer...

 

[Sektor]

I have corrected my code.

Sub HighlightFirstUnique()
    Dim lo As ListObject
    Set lo = ActiveSheet.ListObjects(1)
    With lo.DataBodyRange.Columns(1)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(" & .Cells(1).Address(1, 0) & ":" & .Cells(1).Address(0, 0) & ";" & .Cells(1).Address(0, 0) & ")>1"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub