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

I have tried this on another file not too dissimilar to what I sent you and I get a run-time error '9' subscript out of range and it points to this line?

Nums(Val(Mid(Data(X, 1), PrefixLen + 1)), 1) = ""
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Also I am not sure if it makes a difference but the way excel sorts might mess things up like below. You have SS950 and instead of then SS951 it goes to SS9500.


Excel 2010
A
6467SS9499
6468SS950
6469SS9500
6470SS9501
6471SS9502
6472SS9503
6473SS9504
6474SS9505
6475SS9506
6476SS9507
6477SS9508
6478SS9509
6479SS951
6480SS9510
FILE.0071
 
Upvote 0
Also I am not sure if it makes a difference but the way excel sorts might mess things up like below. You have SS950 and instead of then SS951 it goes to SS9500.
Yes, that affected my code as I assumed the largest number would always be at the bottom of your data. Here is revised code (runs a bit slower) that should work (still outputs to Column C in case that makes a difference)...
Code:
[table="width: 500"]
[tr]
	[td]Sub MissingNumbers()
  Dim X As Long, FirstNum As Long, LastNum As Long, MaxNum 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)
  For X = 1 To UBound(Data)
    If Mid(Data(X, 1), PrefixLen + 1) > MaxNum Then MaxNum = Val(Mid(Data(X, 1), PrefixLen + 1))
  Next
  FirstNum = Val(Mid(Data(1, 1), PrefixLen + 1))
  LastNum = Val(Mid(Data(UBound(Data), 1), PrefixLen + 1))
  Nums = Evaluate("ROW(1:" & MaxNum & ")")
  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
  Columns("C").Clear
  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]C[/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[/td]
[/tr]
[/table]
 
Upvote 0
Yes, that affected my code as I assumed the largest number would always be at the bottom of your data. Here is revised code (runs a bit slower) that should work (still outputs to Column C in case that makes a difference)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub MissingNumbers()
  Dim X As Long, FirstNum As Long, LastNum As Long, MaxNum 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)
  For X = 1 To UBound(Data)
    If Mid(Data(X, 1), PrefixLen + 1) > MaxNum Then MaxNum = Val(Mid(Data(X, 1), PrefixLen + 1))
  Next
  FirstNum = Val(Mid(Data(1, 1), PrefixLen + 1))
  LastNum = Val(Mid(Data(UBound(Data), 1), PrefixLen + 1))
  Nums = Evaluate("ROW(1:" & MaxNum & ")")
  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
  Columns("C").Clear
  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]C[/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[/TD]
[/TR]
</tbody>[/TABLE]

Working great. Can I ask does it matter how many letters are at the start or end of each number? Also in a file do the prefixes have to be all the same?
 
Upvote 0
Can I ask does it matter how many letters are at the start or end of each number?
For my code... no, it does not matter.


Also in a file do the prefixes have to be all the same?
For my code... yes, the prefixes must all be the same. I could probably modify the code to handle different prefixes so long as each individual prefix was grouped together with all of the other same individual prefix (although I would expect the code to be slightly more complex and more sluggish)..
 
Upvote 0
Many thanks for your help Rick, I will keep all the prefixes the same in each file.
 
Upvote 0
Hi Rick. I am getting subscript 9 error again and it points to this row

Nums(Val(Mid(Data(X, 1), PrefixLen + 1)), 1) = ""

Does it matter if some cells have letters on the end and others don't?

Also now the numbers have gone into 5 characters i.e FASS10001 whereas when you did the code it was 4 i.e FASS9998
 
Last edited:
Upvote 0
After running a couple of tests it seems to be when there is more than 8 characters in the cell.
 
Upvote 0

Forum statistics

Threads
1,214,384
Messages
6,119,201
Members
448,874
Latest member
Lancelots

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