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:
Yes, sheet 1 is a helper sheet. Maybe later we can go for a solution that does not use helper columns.
Can you post a small input sample that produces incorrect results? Or, if there are too many rows, email me the workbook?
 
Upvote 0

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
This seems to work:

GLTZCnW.png


Code:
Dim prefix$
Sub Satv()                                          ' run me
Dim orig As Worksheet, aux As Worksheet, lr%, bsr As Range, i%, plen%
Application.ScreenUpdating = False
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.[aa1]
lr = Range("aa" & Rows.Count).End(xlUp).Row
plen = [MIN(FIND({0,1,2,3,4,5,6,7,8,9},AA2&"0123456789"))] - 1
prefix = Left([aa2], plen)
Range("ac2:ac" & lr).Formula = "=right(aa2,len(aa2)-" & plen & ")"
Range("ad2:ad" & lr).Formula = "=min(find({1,2,3,4,5,6,7,8,9},ac2&""123456789""))-1"
NumPart Range("ae2:ae" & lr), "ac2"     ' extract numeric part
Range("ag2:ag" & lr).Formula = "=concatenate(""" & prefix & """,rept(""0"",ad2),ae2)"
[ag:ag].Copy
[a1].PasteSpecial xlPasteValues         ' original data,but no letters to the right
[a1] = "Data"
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(, 5)
Next
Application.ScreenUpdating = True
End Sub

Sub DM(totrange As Range, dr As Range, dest As Range)
Dim a, lr, i&, d As Object, mn&, mx&, pref$, it, s$
Set d = CreateObject("Scripting.Dictionary")
lr = Range(Split(dr.Address, "$")(1) & Rows.Count).End(xlUp).Row
ReDim a(2 To lr)
mx = 0
NumPart Range(Cells(2, dest.Offset(, 1).Column), Cells(lr, dest.Offset(, 1).Column)), _
Split(dr.Address, "$")(1) & "2"
For i = 2 To lr
    a(i) = Cells(i, dest.Offset(, 1).Column)
    If i = 2 Then mn = a(i)
    If a(i) < mn Then mn = a(i)
    If a(i) > mx Then mx = a(i)
Next
For i = mn To mx
    it = prefix & WorksheetFunction.Rept("0", totrange.Value - Len(prefix & i)) & i
    d.Add it, it
Next
For i = 2 To lr
    If d.Exists(Cells(i, dr.Column).Value) Then d.Remove Cells(i, dr.Column).Value
Next
dest.Resize(d.Count).Value = WorksheetFunction.Transpose(d.Keys)
End Sub

Sub NumPart(r As Range, s$)
r.Formula = "=SUMPRODUCT(MID(0&" & s & ",LARGE(INDEX(ISNUMBER(--MID(" & s & _
",ROW(INDIRECT(""1:""&LEN(" & s & "))),1))*ROW(INDIRECT(""1:""&LEN(" & s & _
"))),0),ROW(INDIRECT(""1:""&LEN(" & s & "))))+1,1)*10^ROW(INDIRECT(""1:""&LEN(" & s & ")))/10)"
End Sub

I am trying to run this code now to give you an example of the incorrect results and I am now getting a Visual Basic error '400'?

For now I am going to have to use Ricks code somehow, even though it only seems to cater for 8 characters.
 
Last edited:
Upvote 0
Give me the input data, either here or by email, so I can try to reproduce the error and fix it.
 
Upvote 0
I think the following macro will do what you want. Note that it assumes the same prefix for all values in Column A and that, since you did not say, the output will go to Column C (change the red letters to the column letter designation of the desired output column if different than my guess)...
Code:
Sub MissingNumbers()
  Dim X As Long, FirstNum As Long, LastNum As Long, PrefixLen As Long
  Dim PreFix As String, Nums As Variant, Data As Variant
  Data = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  PrefixLen = [MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))] - 1
  PreFix = Left(Data(1, 1), PrefixLen)
  FirstNum = Val(Mid(Data(1, 1), PrefixLen + 1))
  LastNum = Val(Mid(Data(UBound(Data), 1), PrefixLen + 1))
  Nums = Evaluate("ROW(1:" & LastNum & ")")
  For X = 1 To UBound(Data)
    If X < FirstNum Then
      Nums(X, 1) = ""
    Else
      Nums(Val(Mid(Data(X, 1), PrefixLen + 1)), 1) = ""
    End If
  Next
  Application.ScreenUpdating = False
  Range("[B][COLOR=#FF0000]C[/COLOR][/B]1").Value = "Missing Nums"
  Range("[B][COLOR=#FF0000]C[/COLOR][/B]2").Resize(UBound(Nums)) = Nums
  On Error GoTo Whoops
  With Range("[B][COLOR=#FF0000]C[/COLOR][/B]2", Cells(Rows.Count, "[B][COLOR=#FF0000]C[/COLOR][/B]").End(xlUp))
    .SpecialCells(xlBlanks).Delete xlShiftUp
    .Value = Evaluate("IF(" & .Address & "="""","""",""" & PreFix & """&TEXT(" & .Address & ",""000""))")
  End With
Whoops:
  Application.ScreenUpdating = True
End Sub

For some reason now I am getting invalid procedure call or argument?
 
Upvote 0
No line, that message box pops up as soon as I run it. As I said it seemed to work perfect for 8 characters so I have adapted my data for that but if it could be for more it would be great.
 
Upvote 0
Note that the code from post 62 worked for me with ten numeric characters.
 
Upvote 0
But I get that visual basic 400 error now.
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,220
Members
448,554
Latest member
Gleisner2

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