Code To List Numbers Missing From Sequence
Page 8 of 8 FirstFirst ... 678
Results 71 to 77 of 77

Thread: Code To List Numbers Missing From Sequence
Thanks Thanks: 0 Likes Likes: 0

  1. #71
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,349
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    Would you PM me your email again please.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  2. #72
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,676
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    I tested the code from post 62 with the two data sets you provided and it completed without errors.
    I am sending my test workbook back to you; try it on two different machines if possible.
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  3. #73
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,676
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    This is the version I have on my personal macro workbook. I brought up the macro dialog box with Alt+F8 and executed it from the test workbook, which was the only file open. It worked correctly.

    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:=0
    [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 2, 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
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  4. #74
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,349
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    Quote Originally Posted by Worf View Post
    This is the version I have on my personal macro workbook. I brought up the macro dialog box with Alt+F8 and executed it from the test workbook, which was the only file open. It worked correctly.

    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:=0
    [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 2, 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
    Working much better now, thanks for all your time.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  5. #75
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,349
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    Worf I am now getting a run-time error '13' type mismatch and when I debug it points to this line?

    dest.Resize(d.Count).Value = WorksheetFunction.Transpose(d.Keys)
    Last edited by Dazzawm; Jul 11th, 2019 at 07:30 AM.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  6. #76
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,676
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    As before, I need the input data that generates the error, either here or via email.
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  7. #77
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,349
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To List Numbers Missing From Sequence

    Seems to have been a rogue character messing it up.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •