Hi,
I need assistance in developing a macro that can identify recurring patterns in a set of example data:
50805335
12096109
30537209
44069301
92243134
50850335
77900385
See below a macro that I've been trying to modify:
Sub Macro()
Dim Ray, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer, L5 As Integer, L6 As Integer, L7 As Integer, n As Long
Dim L8 As Integer, c As Long, Dup As Long, Q, nRay
L1 = 1: L2 = 2: L3 = 3: L4 = 4: L5 = 5: L6 = 6: L7 = 7: L8 = 8:
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 40)
For Each Dn In Rng
For n = 1 To Len(Dn)
If Len(Mid(Dn, n, L1)) = L1 Then c = c + 1: Ray(c) = Mid(Dn, n, L1)
If Len(Mid(Dn, n, L2)) = L2 Then c = c + 1: Ray(c) = Mid(Dn, n, L2)
If Len(Mid(Dn, n, L3)) = L3 Then c = c + 1: Ray(c) = Format(Mid(Dn, n, L3), "@")
If Len(Mid(Dn, n, L4)) = L4 Then c = c + 1: Ray(c) = Mid(Dn, n, L4)
If Len(Mid(Dn, n, L5)) = L5 Then c = c + 1: Ray(c) = Mid(Dn, n, L5)
If Len(Mid(Dn, n, L6)) = L6 Then c = c + 1: Ray(c) = Mid(Dn, n, L6)
If Len(Mid(Dn, n, L7)) = L7 Then c = c + 1: Ray(c) = Mid(Dn, n, L7)
If Len(Mid(Dn, n, L8)) = L8 Then c = c + 1: Ray(c) = Mid(Dn, n, L8)
Next n
Next Dn
n = 0
ReDim nRay(1 To UBound(Ray), 1 To 2)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Dup = 1 To UBound(Ray)
If Ray(Dup) <> "" Then
If Not .Exists(Ray(Dup)) Then
n = n + 1
.Add Ray(Dup), Array(1, n)
nRay(n, 1) = Ray(Dup): nRay(n, 2) = "Dups = 1"
Else
Q = .Item(Ray(Dup))
Q(0) = Q(0) + 1
nRay(Q(1), 2) = "Dups = " & Q(0)
.Item(Ray(Dup)) = Q
End If
End If
Next Dup
With Range("D3").Resize(.Count, 2)
.NumberFormat = "@"
.Value = nRay
End With
End With
MsgBox "End"
RESULTS
5 Dups = 8
50 Dups = 3
508 Dups = 2
5080 Dups =1
50805 Dups = 1
5080533 Dups = 1
50805335 Dup = 1
0 Dups = 12
08 Dups = 2
080 Dups = 1
0805 Dups = 1
08053 Dups =1
080533 Dups =1
0805335 Dups = 1
etc.
Unfortunately, the above macro is capturing all duplicates through the entire 8 digit array for all 7 reference numbers. Can someone help me restrict the macro to search for patterns for the specific digit spot in the array. For example, how many times the number "5" shows us in the first digit for all reference numbers should be twice. I was hoping to get the following results:
5 Dups = 2
50 Dups = 2
508 Dups = 2
5080 Dups =1
50805 Dups = 1
5080533 Dups = 1
50805335 Dup = 1
0 Dups = 2
08 Dups = 2
080 Dups = 1
0805 Dups = 1
08053 Dups =1
080533 Dups =1
0805335 Dups = 1
etc.
Thank you,
RL
I need assistance in developing a macro that can identify recurring patterns in a set of example data:
50805335
12096109
30537209
44069301
92243134
50850335
77900385
See below a macro that I've been trying to modify:
Sub Macro()
Dim Ray, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer, L5 As Integer, L6 As Integer, L7 As Integer, n As Long
Dim L8 As Integer, c As Long, Dup As Long, Q, nRay
L1 = 1: L2 = 2: L3 = 3: L4 = 4: L5 = 5: L6 = 6: L7 = 7: L8 = 8:
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 40)
For Each Dn In Rng
For n = 1 To Len(Dn)
If Len(Mid(Dn, n, L1)) = L1 Then c = c + 1: Ray(c) = Mid(Dn, n, L1)
If Len(Mid(Dn, n, L2)) = L2 Then c = c + 1: Ray(c) = Mid(Dn, n, L2)
If Len(Mid(Dn, n, L3)) = L3 Then c = c + 1: Ray(c) = Format(Mid(Dn, n, L3), "@")
If Len(Mid(Dn, n, L4)) = L4 Then c = c + 1: Ray(c) = Mid(Dn, n, L4)
If Len(Mid(Dn, n, L5)) = L5 Then c = c + 1: Ray(c) = Mid(Dn, n, L5)
If Len(Mid(Dn, n, L6)) = L6 Then c = c + 1: Ray(c) = Mid(Dn, n, L6)
If Len(Mid(Dn, n, L7)) = L7 Then c = c + 1: Ray(c) = Mid(Dn, n, L7)
If Len(Mid(Dn, n, L8)) = L8 Then c = c + 1: Ray(c) = Mid(Dn, n, L8)
Next n
Next Dn
n = 0
ReDim nRay(1 To UBound(Ray), 1 To 2)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Dup = 1 To UBound(Ray)
If Ray(Dup) <> "" Then
If Not .Exists(Ray(Dup)) Then
n = n + 1
.Add Ray(Dup), Array(1, n)
nRay(n, 1) = Ray(Dup): nRay(n, 2) = "Dups = 1"
Else
Q = .Item(Ray(Dup))
Q(0) = Q(0) + 1
nRay(Q(1), 2) = "Dups = " & Q(0)
.Item(Ray(Dup)) = Q
End If
End If
Next Dup
With Range("D3").Resize(.Count, 2)
.NumberFormat = "@"
.Value = nRay
End With
End With
MsgBox "End"
RESULTS
5 Dups = 8
50 Dups = 3
508 Dups = 2
5080 Dups =1
50805 Dups = 1
5080533 Dups = 1
50805335 Dup = 1
0 Dups = 12
08 Dups = 2
080 Dups = 1
0805 Dups = 1
08053 Dups =1
080533 Dups =1
0805335 Dups = 1
etc.
Unfortunately, the above macro is capturing all duplicates through the entire 8 digit array for all 7 reference numbers. Can someone help me restrict the macro to search for patterns for the specific digit spot in the array. For example, how many times the number "5" shows us in the first digit for all reference numbers should be twice. I was hoping to get the following results:
5 Dups = 2
50 Dups = 2
508 Dups = 2
5080 Dups =1
50805 Dups = 1
5080533 Dups = 1
50805335 Dup = 1
0 Dups = 2
08 Dups = 2
080 Dups = 1
0805 Dups = 1
08053 Dups =1
080533 Dups =1
0805335 Dups = 1
etc.
Thank you,
RL