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

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,002
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,002
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,002
I will rewrite the code so that it removes the letters on the right.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,002
  • 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,029
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,101,996
Messages
5,484,089
Members
407,430
Latest member
sgoldman

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top