As far as I know, using loops is the fastest approach; although it might not appear concise, it is efficient in terms of speed.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?
Just noticed that when duplicates are found the message box saying 'no duplicate found' pops up rather then the 'found duplicate' box?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
Ah, you're right, I should add one Boolean variable to check the result. Use this one:Just noticed that when duplicates are found the message box saying 'no duplicate found' pops up rather then the 'found duplicate' box?
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