Code To Find Duplicates And Highlight

Dazzawm

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,748
Office Version
  1. 365
Platform
  1. Windows
Is there a code or formula for when there is matching cells in column C that will then look in column AE and highlight any duplicate values please?
 
Sort by date Sort by votes
I need more info to speed up the code.
I assumed 2 things:
1. that within each group defined by column C, there are no identical items in column C that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for AU10018.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
C
2ASVIR53 5001
3ASVIR53 5001
4AU10018 2001
5AU10018 2001
6asdfg
7asdfg
8AU10018 2001
9
10
Sheet4


2. that within each group defined by column C, there are no identical items in column AE that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for Data1.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
BCADAEAF
1
2ASVIR53 5001Data1
3ASVIR53 5001Data2
4AU10018 2001Data1
5AU10018 2001Data2
6AU10018 2001Data2
7AU10018 2001Data1
8AU10018 2001Data4
9
Sheet3




Is my assumption correct?
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Akuini said:
I need more info to speed up the code.
I assumed 2 things:
1. that within each group defined by column C, there are no identical items in column C that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for AU10018.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
C
2ASVIR53 5001
3ASVIR53 5001
4AU10018 2001
5AU10018 2001
6asdfg
7asdfg
8AU10018 2001
9
10
Sheet4


2. that within each group defined by column C, there are no identical items in column AE that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for Data1.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
BCADAEAF
1
2ASVIR53 5001Data1
3ASVIR53 5001Data2
4AU10018 2001Data1
5AU10018 2001Data2
6AU10018 2001Data2
7AU10018 2001Data1
8AU10018 2001Data4
9
Sheet3




Is my assumption correct?
Click to expand...
Correct
 
Upvote 0
Akuini said:
I need more info to speed up the code.
I assumed 2 things:
1. that within each group defined by column C, there are no identical items in column C that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for AU10018.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
C
2ASVIR53 5001
3ASVIR53 5001
4AU10018 2001
5AU10018 2001
6asdfg
7asdfg
8AU10018 2001
9
10
Sheet4


2. that within each group defined by column C, there are no identical items in column AE that are positioned apart from each other. Therefore, they shouldn't appear as shown in red for Data1.
Dazzawm - Code To Find Duplicates And Highlight.xlsm
BCADAEAF
1
2ASVIR53 5001Data1
3ASVIR53 5001Data2
4AU10018 2001Data1
5AU10018 2001Data2
6AU10018 2001Data2
7AU10018 2001Data1
8AU10018 2001Data4
9
Sheet3




Is my assumption correct?
Click to expand...
Actually number 2 they may be apart from each other in AE as your example in red.
 
Upvote 0
Maybe your sheet didn't like UsedRange. My final attempt:
VBA Code: 
Sub test()
  Dim d As Object, columnC As Variant, columnAE As Variant, i As Long, j As Long, counter As Long, s As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Application
  columnC = .Transpose(Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row))
  columnAE = .Transpose(Range("AE1:AE" & Cells(Rows.Count, 31).End(xlUp).Row))
  .ScreenUpdating = False
 
  For i = 2 To UBound(columnC)
    If columnC(i) = columnC(i - 1) Then
      d.Add columnAE(i - 1), 1
      If d.Exists(columnAE(i)) Then
      counter = 0
        For j = s To UBound(columnC)
          If columnC(s) = columnC(j) Then
            counter = counter + 1
          Else
            Exit For
          End If
        Next
        Cells(s, 3).Resize(counter).Interior.Color = 65535
        d.RemoveAll
        i = j
        s = i
      End If
    Else
      s = i
      d.RemoveAll
    End If
  Next

  .ScreenUpdating = True
  End With
End Sub
 
Upvote 0
Flashbond said:
Maybe your sheet didn't like UsedRange. My final attempt:
VBA Code: 
Sub test()
  Dim d As Object, columnC As Variant, columnAE As Variant, i As Long, j As Long, counter As Long, s As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Application
  columnC = .Transpose(Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row))
  columnAE = .Transpose(Range("AE1:AE" & Cells(Rows.Count, 31).End(xlUp).Row))
  .ScreenUpdating = False
 
  For i = 2 To UBound(columnC)
    If columnC(i) = columnC(i - 1) Then
      d.Add columnAE(i - 1), 1
      If d.Exists(columnAE(i)) Then
      counter = 0
        For j = s To UBound(columnC)
          If columnC(s) = columnC(j) Then
            counter = counter + 1
          Else
            Exit For
          End If
        Next
        Cells(s, 3).Resize(counter).Interior.Color = 65535
        d.RemoveAll
        i = j
        s = i
      End If
    Else
      s = i
      d.RemoveAll
    End If
  Next

  .ScreenUpdating = True
  End With
End Sub
Click to expand...
That worked, just missing the extras that @Akuini is sorting. Thanks again for your efforts.
 
Upvote 0
The usage of the Union function proved to be quite slow.
In its revised version, the process is notably faster compared to the previous one. It completed in just 2 seconds when applied to 150,000 rows of data.
Additionally, I've integrated your new criteria, which involves excluding entries with the values NDA, NLA, NA, and NYA.

VBA Code: 
Sub Dazzawm_5()
'' section group looping
Dim i As Long, j As Long, n As Long
Dim c As Range
Dim tx As String
Dim va, vb, ary, x
Dim d As Object
Dim xFlag As Boolean
Dim t As Double

t = Timer
ActiveSheet.Cells.Interior.Color = xlNone
va = Range("C1", Cells(Rows.Count, "C").End(xlUp))
vb = Range("AE1", Cells(Rows.Count, "AE").End(xlUp))
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

'NDA, NLA, NA and NYA
ary = Split("NDA,NLA,NA,NYA", ",")

For i = 1 To UBound(vb, 1)
    For Each x In ary
        If vb(i, 1) = x Then vb(i, 1) = Empty: Exit For
    Next
Next

For i = 2 To UBound(va, 1)
        j = i
        tx = va(i, 1)
        Do
            i = i + 1
            If i > UBound(va, 1) Then Exit Do
        Loop While va(i, 1) = tx
        i = i - 1
        If i <> j Then
                d.RemoveAll
                xFlag = False
                For n = j To i
                    If vb(n, 1) <> "" Then
                        If Not d.Exists(vb(n, 1)) Then
                            d(vb(n, 1)) = Empty
                        Else
                            xFlag = True
                            Exit For
                        End If
                    End If
                Next
                
                If xFlag Then Range(Cells(j, "C"), Cells(i, "C")).EntireRow.Interior.Color = vbYellow

        End If
Next

Debug.Print "It's done in:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

GXXNLA
GXXNLA
Ja
Kb
Ma
Ma
Mb
Sa
Sb
Sc
Ua
Ub
Ua
QNLA
QNLA
 
Upvote 0
Akuini said:
The usage of the Union function proved to be quite slow.
In its revised version, the process is notably faster compared to the previous one. It completed in just 2 seconds when applied to 150,000 rows of data.
Additionally, I've integrated your new criteria, which involves excluding entries with the values NDA, NLA, NA, and NYA.

VBA Code: 
Sub Dazzawm_5()
'' section group looping
Dim i As Long, j As Long, n As Long
Dim c As Range
Dim tx As String
Dim va, vb, ary, x
Dim d As Object
Dim xFlag As Boolean
Dim t As Double

t = Timer
ActiveSheet.Cells.Interior.Color = xlNone
va = Range("C1", Cells(Rows.Count, "C").End(xlUp))
vb = Range("AE1", Cells(Rows.Count, "AE").End(xlUp))
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

'NDA, NLA, NA and NYA
ary = Split("NDA,NLA,NA,NYA", ",")

For i = 1 To UBound(vb, 1)
    For Each x In ary
        If vb(i, 1) = x Then vb(i, 1) = Empty: Exit For
    Next
Next

For i = 2 To UBound(va, 1)
        j = i
        tx = va(i, 1)
        Do
            i = i + 1
            If i > UBound(va, 1) Then Exit Do
        Loop While va(i, 1) = tx
        i = i - 1
        If i <> j Then
                d.RemoveAll
                xFlag = False
                For n = j To i
                    If vb(n, 1) <> "" Then
                        If Not d.Exists(vb(n, 1)) Then
                            d(vb(n, 1)) = Empty
                        Else
                            xFlag = True
                            Exit For
                        End If
                    End If
                Next
               
                If xFlag Then Range(Cells(j, "C"), Cells(i, "C")).EntireRow.Interior.Color = vbYellow

        End If
Next

Debug.Print "It's done in:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

GXXNLA
GXXNLA
Ja
Kb
Ma
Ma
Mb
Sa
Sb
Sc
Ua
Ub
Ua
QNLA
QNLA
Click to expand...
Seems absolutely perfect, I can't thank you enough. FYI the message box saying no duplicates found didn't appear and the timer didn't pop up either. But this is no problem.
 
Upvote 0
@Flashbond
Transpose on an array in VBA, the array must be no more than 65,536 rows long. Otherwise it only get the remaining items and unfortunately without raising an error.
Try this:
VBA Code: 
Sub test_Transppose_limit()
vb = Application.Transpose(Range("A1:A100000"))
Debug.Print UBound(vb)  'returns: 34464,  it's 100000 - 65536
End Sub
 
Upvote 0
Akuini said:
@Flashbond
Transpose on an array in VBA, the array must be no more than 65,536 rows long. Otherwise it only get the remaining items and unfortunately without raising an error.
Try this:
VBA Code: 
Sub test_Transppose_limit()
vb = Application.Transpose(Range("A1:A100000"))
Debug.Print UBound(vb)  'returns: 34464,  it's 100000 - 65536
End Sub
Click to expand...
Oh, that's interesting. I didn't know that. I used to use in my projects regularly. So what will be the best practice to convert 2D array into a 1D array?
 
Upvote 0
Dazzawm said:
Seems absolutely perfect, I can't thank you enough. FYI the message box saying no duplicates found didn't appear and the timer didn't pop up either. But this is no problem.
Click to expand...
Here's for the message:
VBA Code: 
Sub Dazzawm_6()
'' section group looping
Dim i As Long, j As Long, n As Long
Dim c As Range
Dim tx As String
Dim va, vb, ary, x
Dim d As Object
Dim xFlag As Boolean
Dim t As Double

t = Timer
ActiveSheet.Cells.Interior.Color = xlNone
va = Range("C1", Cells(Rows.Count, "C").End(xlUp))
vb = Range("AE1", Cells(Rows.Count, "AE").End(xlUp))
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

'NDA, NLA, NA and NYA
ary = Split("NDA,NLA,NA,NYA", ",")

For i = 1 To UBound(vb, 1)
    For Each x In ary
        If vb(i, 1) = x Then vb(i, 1) = Empty: Exit For
    Next
Next

For i = 2 To UBound(va, 1)
        j = i
        tx = va(i, 1)
        Do
            i = i + 1
            If i > UBound(va, 1) Then Exit Do
        Loop While va(i, 1) = tx
        i = i - 1
        If i <> j Then
                d.RemoveAll
                xFlag = False
                For n = j To i
                    If vb(n, 1) <> "" Then
                        If Not d.Exists(vb(n, 1)) Then
                            d(vb(n, 1)) = Empty
                        Else
                            xFlag = True
                            Exit For
                        End If
                    End If
                Next
                
                If xFlag Then Range(Cells(j, "C"), Cells(i, "C")).EntireRow.Interior.Color = vbYellow

        End If
Next

If xFlag = True Then
    MsgBox "Found duplicate" & vbLf & "It's done in:  " & Format(Timer - t, "0.00") & " seconds"
Else
    MsgBox "No duplicate found"
End If

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Highlighting a duplication
Replies
1
Views
119
etaf
etaf
W
  • Question
Highlight duplicates based on another column
Replies
2
Views
147
wikus
W
K
  • Question
Remove Duplicate option not working using expand selection method whereas the value in column G are numbers which are duplicate and highlighted
Replies
1
Views
565
kumail
K
montecarlo2012
  • Question
[excel2007] highlight duplicates.
Replies
6
Views
340
montecarlo2012
montecarlo2012
M
  • Question
DR/CR Matching
Replies
3
Views
160
Joe4
Joe4

Forum statistics

Threads
1,215,140
Messages
6,123,269
Members
449,093
Latest member
Vincent Khandagale

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top