Is there a way to use VBA code to identify unique rows in my data?

[Giovanni03]

Hello!

I'm looking to see if there's a way to use VBA code to identify unique rows in my sheet. I have code that identifies unique in a column but cant seem to make it work for an entire row.

My Data has 9 columns, and two of them are the main ones that will show me that the row is unique.

For example,

Date​	Assignment #1	location​	Order # 1	0:10:00​	John Doe #1	DELIVERY	Item #1​	Item Description
Date​	Assignment #2	location​	Order # 2	0:20:00​	John Doe #2	Service	Item #2​	Item Description
Date​	Assignment #1	location​	Order # 1	0:20:00​	John Doe #1	DELIVERY	Item #1​	Item Description

My goal is to identify orders that show up only once (Column D) as well as column G stating "Service".

 

[DanteAmor]

Hi @Giovanni03
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

With conditional formating:

Dante Amor
	A	B	C	D	E	F	G	H	I
1	Date	Assignment #1	location	Order # 1	0:10:00	John Doe #1	DELIVERY	Item #1	Item Description
2	Date	Assignment #2	location	Order # 2	0:20:00	John Doe #2	Service	Item #2	Item Description
3	Date	Assignment #1	location	Order # 1	0:20:00	John Doe #1	DELIVERY	Item #1	Item Description
4	Date	Assignment #2	location	Order # 2	0:20:00	John Doe #2	DELIVERY	Item #2	Item Description
Hoja6

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D:D,G:G	Expression	=COUNTIFS($D:$D,$D1,$G:$G,$G1)=1	text	NO

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[DanteAmor]

If you prefer the macro, I show you 2 options, the second one should be faster if you have a lot of records.

First:

Sub countuniques_v1()
  Dim c As Range
  Dim lr As Long
  
  lr = Range("D" & Rows.Count).End(3).Row
  For Each c In Range("D1:D" & lr)
    If WorksheetFunction.CountIfs(Range("D1:D" & lr), c.Value, Range("G1:G" & lr), c.Offset(, 3).Value) = 1 Then
      Range("D" & c.Row & ",G" & c.Row).Interior.Color = vbYellow
    End If
  Next
End Sub

Second:

Sub countuniques_v2()
  Dim i As Long
  Dim dic As Object
  Dim ky As String
  Dim itm As Variant
  Dim rng As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set rng = Range("A1")
  For i = 1 To Range("D" & Rows.Count).End(3).Row
    ky = Range("D" & i).Value & "|" & Range("G" & i).Value
    If Not dic.exists(ky) Then dic(ky) = i Else dic.Remove ky
  Next
  For Each itm In dic.items
    Set rng = Union(rng, Range("D" & itm & ",G" & itm))
  Next
  If Not rng Is Nothing Then rng.Interior.Color = vbYellow
  Range("A1").Interior.Color = xlNone
End Sub

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​

 

[Giovanni03]

Thank you for the reply Dante, I tried both codes and they are highlighting duplicates, some are unique but others are dups. I'm wondering if i can just do it by column and not entire row. like if a name only shows up once and the other column states "Service" then highlight both cells.

 

[DanteAmor]

In my tests the 2 macros works.
You can put your sample data here before running the macro.
Another image after running the macro and a third image with the expected result.

 

[Giovanni03]

The two images to the left is what it looks like when i run the code. ideally i would like to only highlight unique orders with a service line not delivery.

 

[DanteAmor]

Ok, I think I understood.
It looks like your data starts in row 2.
Then try this macro.

Sub countuniques_v1()
  Dim c As Range
  Dim lr As Long
 
  Range("D:G").Interior.Color = xlNone
  lr = Range("D" & Rows.Count).End(3).Row
  For Each c In Range("D2:D" & lr)
    If WorksheetFunction.CountIf(Range("D2:D" & lr), c.Value) = 1 And _
      Range("G" & c.Row).Value = "SERVICE" Then
      Range("D" & c.Row & ",G" & c.Row).Interior.Color = vbYellow
    End If
  Next
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[Alex Blakenburg]

I was quite partial to Dante's option 2 in post #3.

Here it is modified for the new understanding of the requirements. It will be much faster than using Countif

Sub countuniques_v3()
    Dim i As Long
    Dim dic As Object
    Dim ky As String
    Dim itm As Variant
    Dim rng As Range, rngHighlight As Range
    Dim arr As Variant
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set rng = Range("D1:G" & Cells(Rows.Count, "D").End(xlUp).Row)
    arr = rng.Value
    For i = 2 To UBound(arr)
        ky = CStr(arr(i, 1))
        If Not dic.exists(ky) Then
            dic(ky) = i
        Else
            dic(ky) = "X"
        End If
    Next i
    
    For Each itm In dic.items
        If itm <> "X" Then
            If UCase(arr(itm, 4)) <> "DELIVERY" Then
            'If Not StrComp(arr(itm, 4), "DELIVERY", vbTextCompare) Then
                If rngHighlight Is Nothing Then
                    Set rngHighlight = Range("D" & itm & ",G" & itm)
                Else
                    Set rngHighlight = Union(rngHighlight, Range("D" & itm & ",G" & itm))
                End If
            End If
        End If
    Next itm
    
    If Not rngHighlight Is Nothing Then rngHighlight.Interior.Color = vbYellow

End Sub

 

[DanteAmor]

Hi @Giovanni03

I had already updated my version 2 with dictionary management, I was just waiting for your confirmation of the result.
Here I present my version 2.

Sub countuniques_v2()
  Dim i As Long, dic As Object, ky As String
  Dim itm As Variant, rng As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
  Range("D:G").Interior.Color = xlNone
  Set rng = Range("D1")
  For i = 2 To Range("D" & Rows.Count).End(3).Row
    ky = Range("D" & i).Value
    If Not dic.exists(ky) Then
      If UCase(Range("G" & i).Value) = UCase("SERVICE") Then dic(ky) = i Else dic(ky) = Empty
    Else
      dic(ky) = Empty
    End If
  Next
  
  For Each itm In dic.items
    If itm <> "" Then Set rng = Union(rng, Range("D" & itm & ",G" & itm))
  Next
  If Not rng Is Nothing Then rng.Interior.Color = vbYellow
  Range("D1").Interior.Color = xlNone
End Sub

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​

 

[Giovanni03]

Apologies for the late reply, holiday weekend.

Dante i tried your code and it worked!!!! Thank you so much for the help with this.

VBA Code:
Sub countuniques_v1()
Dim c As Range
Dim lr As Long
 
Range("D:G").Interior.Color = xlNone
lr = Range("D" & Rows.Count).End(3).Row
For Each c In Range("D2:D" & lr)
If WorksheetFunction.CountIf(Range("D2:D" & lr), c.Value) = 1 And _
Range("G" & c.Row).Value = "SERVICE" Then
Range("D" & c.Row & ",G" & c.Row).Interior.Color = vbYellow
End If
Next
End Sub