Code To Find Duplicates And Highlight

[Dazzawm]

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?

 

[Akuini]

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?

As far as I know, using loops is the fastest approach; although it might not appear concise, it is efficient in terms of speed.
Please check this discussion:

One-dimensional array from Excel Range

I'm presently populating my array Securities with the following code: Option Base 1 Securities = Array(Worksheets(3).Range("A8:A" & SymbolCount).Value) This produces a 2-dimensional array where

stackoverflow.com

 

[Dazzawm]

Here's for the message:

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

Just noticed that when duplicates are found the message box saying 'no duplicate found' pops up rather then the 'found duplicate' box?

 

[Akuini]

Just noticed that when duplicates are found the message box saying 'no duplicate found' pops up rather then the 'found duplicate' box?

Ah, you're right, I should add one Boolean variable to check the result. Use this one:

Sub Dazzawm_7()
'' 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, aFlag As Boolean
Dim t As Double

t = Timer
Application.ScreenUpdating = False
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
                            aFlag = 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

Application.ScreenUpdating = True
If aFlag = 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

 

[Dazzawm]

Thanks

 

[Akuini]

You're welcome.