Code To List Numbers Missing From Sequence

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
This version should work with a variable number of digits and letters. It extracts the numeric part to column B and lists the missing numbers on column D.

Code:
Sub DM()
Dim a, lr, i%, d As Object
Set d = CreateObject("Scripting.Dictionary")
lr = Range("A" & Rows.Count).End(xlUp).Row
ReDim a(2 To lr)
For i = 2 To lr
    a(i) = StrReverse(Val(StrReverse(Cells(i, 1))))
Next
[b2].Resize(UBound(a) - 1, 1).Value = WorksheetFunction.Transpose(a)
For i = WorksheetFunction.Min([b:b]) To WorksheetFunction.Max([b:b])
    d.Add i, i
Next
For i = 2 To Range("b" & Rows.Count).End(xlUp).Row
    If d.exists(Cells(i, 2).Value) Then d.Remove Cells(i, 2).Value
Next
[d2].Resize(d.Count).Value = WorksheetFunction.Transpose(d.keys)
End Sub
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
Thanks Worf. 2 things. Firstly there is data in column B & C which is why I wanted the missing numbers in column D (I didn't think data in B and C would make a difference to the code), and secondly I really need the prefixes to remain.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
This version does not write to any auxiliary column.
As you said the prefix should be the same, I am extracting it from cell A2.

Code:
Sub DM()
Dim a, lr, i%, d As Object, mn%, mx%, pref$
Set d = CreateObject("Scripting.Dictionary")
lr = Range("A" & Rows.Count).End(xlUp).Row
ReDim a(2 To lr)
pref = Mid([a2], 1, Len([a2]) - Len(CStr(Val(StrReverse([a2])))))
mn = 30000: mx = 0
For i = 2 To lr
    a(i) = StrReverse(Val(StrReverse(Cells(i, 1))))
    If a(i) < mn Then mn = a(i)
    If a(i) > mx Then mx = a(i)
Next
For i = mn To mx
    d.Add pref & i, pref & i
Next
For i = LBound(a) To UBound(a)
    If d.exists(pref & a(i)) Then d.Remove pref & a(i)
Next
[d2].Resize(d.Count).Value = WorksheetFunction.Transpose(d.keys)
End Sub
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
Thanks Worf, almost there. But there is a problem when I have a set of numbers like below.

Excel 2010
A
2FASS001
3FASS002
4FASS003
5FASS004
6FASS005
7FASS006
8FASS007
9FASS012
10FASS016
11FASS017
12FASS020
13FASS021
14FASS022
15FASS023
16FASS024
17FASS025
18FASS026
19FASS027
20FASS028
21FASS029
22FASS030
23FASS031
24FASS032
25FASS033
26FASS034
27FASS035
28FASS036
29FASS037
30FASS038
31FASS039
32FASS040
33FASS041
34FASS042
35FASS043
36FASS044
37FASS045
38FASS046
39FASS048
40FASS049
41FASS050
42FASS051
43FASS052
44FASS053
45FASS054
46FASS055
47FASS056
48FASS057
49FASS058
50FASS059
51FASS060
52FASS061
53FASS062
54FASS063
55FASS064
56FASS065
57FASS066
58FASS069
59FASS077
60FASS078
61FASS079
62FASS080
63FASS081
64FASS082
65FASS083
66FASS084
67FASS085
68FASS086
69FASS087
70FASS090
71FASS091
72FASS092
73FASS093
74FASS094
75FASS098

<colgroup><col style="width: 25pxpx" https:="" www.mrexcel.com="" forum="" usertag.php?do="list&action=hash&hash=DAE7F5"" target="_blank"></colgroup><colgroup><col></colgroup><thead>
</thead><tbody>
</tbody>
sheet1



These are the results after the code has run?

Excel 2010
D
2FASS1
3FASS2
4FASS3
5FASS4
6FASS5
7FASS6
8FASS7
9FASS8
10FASS9
11FASS10
12FASS11
13FASS12
14FASS13
15FASS14
16FASS15
17FASS16
18FASS17
19FASS18
20FASS19
21FASS20
22FASS21
23FASS22
24FASS23
25FASS24
26FASS25
27FASS26
28FASS27
29FASS28
30FASS29
31FASS30
32FASS31
33FASS32
34FASS33
35FASS34
36FASS35
37FASS36
38FASS37
39FASS38
40FASS39
41FASS40
42FASS41
43FASS42
44FASS43
45FASS44
46FASS45
47FASS46
48FASS47
49FASS48
50FASS49
51FASS50
52FASS51
53FASS52
54FASS53
55FASS54
56FASS55
57FASS56
58FASS57
59FASS58
60FASS59
61FASS60
62FASS61
63FASS62
64FASS63
65FASS64
66FASS65
67FASS66
68FASS67
69FASS68
70FASS69
71FASS70
72FASS71
73FASS72
74FASS73
75FASS74
76FASS75
77FASS76
78FASS77
79FASS78
80FASS79
81FASS80
82FASS81
83FASS82
84FASS83
85FASS84
86FASS85
87FASS86
88FASS87
89FASS88
90FASS89
91FASS90
92FASS91
93FASS92
94FASS93
95FASS94
96FASS95
97FASS96
98FASS97
99FASS98

<colgroup><col style="width: 25pxpx" https:="" www.mrexcel.com="" forum="" usertag.php?do="list&action=hash&hash=DAE7F5"" target="_blank"></colgroup><colgroup><col></colgroup><thead>
</thead><tbody>
</tbody>
sheet1



As you can see its not listing the numbers it should for example FASS008, FASS009, it seems to be missing the leading zero?
 
Last edited:

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
Therefore, the code should deal with leading zeros and strings of variable length, as shown below. I will work on it.

Excel Workbook
A
1data
2SS010
3SS013
4SS016
5SS0098
6SS0101
7SS0104
8SS0107
table of values
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
This test code shows the method I am proposing, note that columns G and K hold the missing data.
I will be back later with the final version.

Excel Workbook
ABCDEFGHIJKLMN
1datalendatalendatalenlenlen
2SS010
5
VERDADEIRO
SS0105SS011
FALSO
SS00986SS00995
3SS013
5
SS0135SS012SS01016SS01006
4SS016
5
SS0165SS014SS01046SS0102
5SS0098
6
SS015SS01076SS0103
6SS0101
6
SS0105
7SS0104
6
SS0106
8SS0107
6
table of values

Code:
Sub main()
DM [f2], [e2], [g2]
DM [j2], [i2], [k2]
End Sub


Sub DM(totrange As Range, drng As Range, dest As Range)
Dim a, lr, i%, d As Object, mn%, mx%, pref$, it, j%
Set d = CreateObject("Scripting.Dictionary")
lr = Range(Split(drng.Address, "$")(1) & Rows.count).End(xlUp).Row
If lr > 20 Then Exit Sub
ReDim a(2 To lr)
j = 0
Do
    j = j + 1
Loop While Not IsNumeric(Mid(drng, j, 1)) And j < 20
j = j - 1
pref = Left(drng, j)
mn = 30000: mx = 0
For i = 2 To lr
    a(i) = Right(Cells(i, drng.Column), Len(Cells(i, drng.Column)) - j)
    If a(i) < mn Then mn = a(i)
    If a(i) > mx Then mx = a(i)
Next
For i = mn To mx
    it = pref & WorksheetFunction.Rept("0", totrange.Value - Len(pref & i)) & i
    d.Add it, it
Next
For i = 2 To lr
    If d.Exists(Cells(i, drng.Column).Value) Then d.Remove Cells(i, drng.Column).Value
Next
dest.Resize(d.count).Value = WorksheetFunction.Transpose(d.Keys)
End Sub
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
This version uses an auxiliary sheet for calculations:



<strike></strike>
Code:
Sub Satv()
Dim orig As Worksheet, aux As Worksheet, lr%, bsr As Range, i%
Set aux = Sheets("sheet1")              ' auxiliary sheet
Set orig = Sheets("plan2")              ' original sheet
orig.[d:d].ClearContents
orig.[d1] = "Result"
aux.Activate
Cells.ClearContents
orig.[a:a].Copy aux.[a1]
lr = Range("a" & Rows.Count).End(xlUp).Row
[b1] = "Len"
[b2].FormulaR1C1 = "=LEN(RC[-1])"
[b2].AutoFill Destination:=Range("B2:B" & lr), Type:=xlFillDefault
[c1] = [b1]
Range("b1:b" & lr).AdvancedFilter xlFilterCopy, [c1:c2], [d1], True
Set bsr = [e1]
For i = 2 To Range("d" & Rows.Count).End(xlUp).Row
    bsr.Offset(1).Formula = "=b2=" & Cells(i, 4)
    Range("a1:b" & lr).AdvancedFilter xlFilterCopy, bsr.Resize(2, 1), bsr.Offset(, 1), False
    DM bsr.Offset(1, 2), bsr.Offset(1, 1), bsr.Offset(1, 3)
    Range(Cells(2, bsr.Offset(, 3).Column), Cells(Range(Split(bsr.Offset(, 3).Address, "$")(1) _
    & Rows.Count).End(xlUp).Row, bsr.Offset(, 3).Column)).Copy _
    orig.Cells(orig.Range("d" & Rows.Count).End(xlUp).Row + 1, 4)
    Set bsr = bsr.Offset(, 4)
Next
End Sub

Sub DM(totrange As Range, drng As Range, dest As Range)
Dim a, lr, i%, d As Object, mn%, mx%, pref$, it, j%
Set d = CreateObject("Scripting.Dictionary")
lr = Range(Split(drng.Address, "$")(1) & Rows.Count).End(xlUp).Row
ReDim a(2 To lr)
j = 0
Do
    j = j + 1
Loop While Not IsNumeric(Mid(drng, j, 1)) And j < 20
j = j - 1
pref = Left(drng, j)
mn = 30000: mx = 0
For i = 2 To lr
    a(i) = Right(Cells(i, drng.Column), Len(Cells(i, drng.Column)) - j)
    If a(i) < mn Then mn = a(i)
    If a(i) > mx Then mx = a(i)
Next
For i = mn To mx
    it = pref & WorksheetFunction.Rept("0", totrange.Value - Len(pref & i)) & i
    d.Add it, it
Next
For i = 2 To lr
    If d.Exists(Cells(i, drng.Column).Value) Then d.Remove Cells(i, drng.Column).Value
Next
dest.Resize(d.Count).Value = WorksheetFunction.Transpose(d.Keys)
End Sub
 
Last edited:

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
Thanks worf, when I run the above I get 'subscript out of range'?
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,969
On what code line?
Do you have worksheets named Sheet1 and Plan2, as explained in the code comments?
 

Watch MrExcel Video

Forum statistics

Threads
1,099,249
Messages
5,467,524
Members
406,544
Latest member
semoredhawk

This Week's Hot Topics

Top