Code To List Numbers Missing From Sequence

[Dazzawm]

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
SS9822
SS9824
SS9826
SS9828
SS9830
SS9831
SS9833

<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>
[TD="align: center"]4565[/TD]

[TD="align: center"]4566[/TD]

[TD="align: center"]4567[/TD]

[TD="align: center"]4568[/TD]

[TD="align: center"]4569[/TD]

[TD="align: center"]4570[/TD]

[TD="align: center"]4571[/TD]

</tbody>

​

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

Excel 2010

	D
SS9823
SS9825
SS9827
SS9829
SS9832

<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>
[TD="align: center"]4565[/TD]

[TD="align: center"]4566[/TD]

[TD="align: center"]4567[/TD]

[TD="align: center"]4568[/TD]

[TD="align: center"]4569[/TD]

</tbody>

​

Thanks

 

[Worf]

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?

 

[Dazzawm]

This seems to work:

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.

 

[Worf]

Give me the input data, either here or by email, so I can try to reproduce the error and fix it.

 

[Dazzawm]

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

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?

 

[Rick Rothstein]

For some reason now I am getting invalid procedure call or argument?

On what line of code?

 

[Dazzawm]

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.

 

[Worf]

Note that the code from post 62 worked for me with ten numeric characters.

 

[Dazzawm]

But I get that visual basic 400 error now.

 

[Dazzawm]

On what line of code?

I know this is not the reason but I have changed PCs but its the same version of Excel. Only thing I can think of why it stopped working all of a sudden!

 

[Worf]

But I get that visual basic 400 error now.

If you show me the input data that produces the error, I can investigate the issue. No results are necessary since it errors out.