Code To List Numbers Missing From Sequence

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,748
Office Version
  1. 365
Platform
  1. Windows
I have a very long list of numbers in column A and I would like a code to tell me which numbers are missing from the sequence. Below is an example.

Excel 2010
A
4565SS9822
4566SS9824
4567SS9826
4568SS9828
4569SS9830
4570SS9831
4571SS9833

<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>




So from above the following numbers are missing so I would like a list of these made in column D.

Excel 2010
D
4565SS9823
4566SS9825
4567SS9827
4568SS9829
4569SS9832

<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>




Thanks
 
Last edited:
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
 
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
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.
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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
2SS0105VERDADEIROSS0105SS011FALSOSS00986SS00995
3SS0135SS0135SS012SS01016SS01006
4SS0165SS0165SS014SS01046SS0102
5SS00986SS015SS01076SS0103
6SS01016SS0105
7SS01046SS0106
8SS01076
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
 
Upvote 0
This version uses an auxiliary sheet for calculations:

ZFlv9Hd.png


<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:
Upvote 0
Thanks worf, when I run the above I get 'subscript out of range'?
 
Upvote 0
On what code line?
Do you have worksheets named Sheet1 and Plan2, as explained in the code comments?
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

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