Code To List Numbers Missing From Sequence

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
I now get a box come up with a 400 in. And when I select ok sheet 1 ends up as below.

<b>Excel 2010</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5 " /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5 ;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style=";">Plan2</td><td style="text-align: right;;">5</td><td style="text-align: right;;">5</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;;"></td><td style="text-align: right;;">0</td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5 ;color: #161120">sheet1</p><br /><br />

And plan2 is as below.

<b>Excel 2010</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5 " /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5 ;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style=";">Plan2</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">Result</td></tr></tbody></table><p style="width:3em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5 ;color: #161120">plan2</p><br /><br />
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
How many rows are there in column A? Can you email me the workbook?
I need to see the input data.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
There is data in the format SS2311XT.
Should the code ignore the letters on the right side?
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
Yes, sorry I didn't realise they were in there
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
I will rewrite the code so that it removes the letters on the right.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
  • The parts after the letter removal were already there, so the code is simply excluding parts that end with letters.
  • 5266 missing parts were found.
  • Note that Sheet1 should be a blank sheet, while Plan2 holds the part list; of course these names can be changed.

Code:
Sub Satv()                                          ' run me
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.[aa1]
[ab2].Formula = "=not(iserr(value(right(aa2,1))))"  ' no letter on the right side
Range("aa:aa").AdvancedFilter xlFilterCopy, [ab1:ab2], [a1], True
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, dr 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(dr.Address, "$")(1) & Rows.Count).End(xlUp).Row
ReDim a(2 To lr)
j = 0
Do
    j = j + 1
Loop While Not IsNumeric(Mid(dr, j, 1)) And j < 20
j = j - 1
pref = Left(dr, j)
mn = 30000: mx = 0
For i = 2 To lr
    a(i) = Right(Cells(i, dr.Column), Len(Cells(i, dr.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, dr.Column).Value) Then d.Remove Cells(i, dr.Column).Value
Next
dest.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 I will try at work tomorrow and let you know.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,041
Office Version
2010
Platform
Windows
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
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,398
Office Version
2016
Platform
Windows
Thanks Rick seems to work perfect. Thanks for all the time you have put into it also Worf. It seems to give some strange results in some columns but there is a column with the missing numbers. Its amazing with VBA how both codes are so different but in the end it gives you the same result. If I have any problems with any other files I use it on I will let you know. Thanks both again.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,476
Messages
5,487,104
Members
407,578
Latest member
jana007

This Week's Hot Topics

Top