Thanks Worf. 2 things. Firstly there is data in column B & C which is why I wanted the missing numbers in column D (I didn't think data in B and C would make a difference to the code), and secondly I really need the prefixes to remain.
This version should work with a variable number of digits and letters. It extracts the numeric part to column B and lists the missing numbers on column D.
Code:Sub DM() Dim a, lr, i%, d As Object Set d = CreateObject("Scripting.Dictionary") lr = Range("A" & Rows.Count).End(xlUp).Row ReDim a(2 To lr) For i = 2 To lr a(i) = StrReverse(Val(StrReverse(Cells(i, 1)))) Next [b2].Resize(UBound(a) - 1, 1).Value = WorksheetFunction.Transpose(a) For i = WorksheetFunction.Min([b:b]) To WorksheetFunction.Max([b:b]) d.Add i, i Next For i = 2 To Range("b" & Rows.Count).End(xlUp).Row If d.exists(Cells(i, 2).Value) Then d.Remove Cells(i, 2).Value Next [d2].Resize(d.Count).Value = WorksheetFunction.Transpose(d.keys) End Sub
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
Thanks Worf. 2 things. Firstly there is data in column B & C which is why I wanted the missing numbers in column D (I didn't think data in B and C would make a difference to the code), and secondly I really need the prefixes to remain.
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
This version does not write to any auxiliary column.
As you said the prefix should be the same, I am extracting it from cell A2.
Code:Sub DM() Dim a, lr, i%, d As Object, mn%, mx%, pref$ Set d = CreateObject("Scripting.Dictionary") lr = Range("A" & Rows.Count).End(xlUp).Row ReDim a(2 To lr) pref = Mid([a2], 1, Len([a2]) - Len(CStr(Val(StrReverse([a2]))))) mn = 30000: mx = 0 For i = 2 To lr a(i) = StrReverse(Val(StrReverse(Cells(i, 1)))) If a(i) < mn Then mn = a(i) If a(i) > mx Then mx = a(i) Next For i = mn To mx d.Add pref & i, pref & i Next For i = LBound(a) To UBound(a) If d.exists(pref & a(i)) Then d.Remove pref & a(i) Next [d2].Resize(d.Count).Value = WorksheetFunction.Transpose(d.keys) End Sub
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
Thanks Worf, almost there. But there is a problem when I have a set of numbers like below.
Excel 2010
A 2 FASS001 3 FASS002 4 FASS003 5 FASS004 6 FASS005 7 FASS006 8 FASS007 9 FASS012 10 FASS016 11 FASS017 12 FASS020 13 FASS021 14 FASS022 15 FASS023 16 FASS024 17 FASS025 18 FASS026 19 FASS027 20 FASS028 21 FASS029 22 FASS030 23 FASS031 24 FASS032 25 FASS033 26 FASS034 27 FASS035 28 FASS036 29 FASS037 30 FASS038 31 FASS039 32 FASS040 33 FASS041 34 FASS042 35 FASS043 36 FASS044 37 FASS045 38 FASS046 39 FASS048 40 FASS049 41 FASS050 42 FASS051 43 FASS052 44 FASS053 45 FASS054 46 FASS055 47 FASS056 48 FASS057 49 FASS058 50 FASS059 51 FASS060 52 FASS061 53 FASS062 54 FASS063 55 FASS064 56 FASS065 57 FASS066 58 FASS069 59 FASS077 60 FASS078 61 FASS079 62 FASS080 63 FASS081 64 FASS082 65 FASS083 66 FASS084 67 FASS085 68 FASS086 69 FASS087 70 FASS090 71 FASS091 72 FASS092 73 FASS093 74 FASS094 75 FASS098 sheet1
These are the results after the code has run?
Excel 2010
D 2 FASS1 3 FASS2 4 FASS3 5 FASS4 6 FASS5 7 FASS6 8 FASS7 9 FASS8 10 FASS9 11 FASS10 12 FASS11 13 FASS12 14 FASS13 15 FASS14 16 FASS15 17 FASS16 18 FASS17 19 FASS18 20 FASS19 21 FASS20 22 FASS21 23 FASS22 24 FASS23 25 FASS24 26 FASS25 27 FASS26 28 FASS27 29 FASS28 30 FASS29 31 FASS30 32 FASS31 33 FASS32 34 FASS33 35 FASS34 36 FASS35 37 FASS36 38 FASS37 39 FASS38 40 FASS39 41 FASS40 42 FASS41 43 FASS42 44 FASS43 45 FASS44 46 FASS45 47 FASS46 48 FASS47 49 FASS48 50 FASS49 51 FASS50 52 FASS51 53 FASS52 54 FASS53 55 FASS54 56 FASS55 57 FASS56 58 FASS57 59 FASS58 60 FASS59 61 FASS60 62 FASS61 63 FASS62 64 FASS63 65 FASS64 66 FASS65 67 FASS66 68 FASS67 69 FASS68 70 FASS69 71 FASS70 72 FASS71 73 FASS72 74 FASS73 75 FASS74 76 FASS75 77 FASS76 78 FASS77 79 FASS78 80 FASS79 81 FASS80 82 FASS81 83 FASS82 84 FASS83 85 FASS84 86 FASS85 87 FASS86 88 FASS87 89 FASS88 90 FASS89 91 FASS90 92 FASS91 93 FASS92 94 FASS93 95 FASS94 96 FASS95 97 FASS96 98 FASS97 99 FASS98 sheet1
As you can see its not listing the numbers it should for example FASS008, FASS009, it seems to be missing the leading zero?
Last edited by Dazzawm; May 20th, 2019 at 11:44 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
Therefore, the code should deal with leading zeros and strings of variable length, as shown below. I will work on it.
table of values
A 1 data 2 SS010 3 SS013 4 SS016 5 SS0098 6 SS0101 7 SS0104 8 SS0107
Excel tables to the web >> Excel Jeanie HTML 4
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
OK thanks worf
This test code shows the method I am proposing, note that columns G and K hold the missing data.
I will be back later with the final version.
table of values
A B C D E F G H I J K L M N 1 data len data len data len len len 2 SS010 5 VERDADEIRO SS010 5 SS011 FALSO SS0098 6 SS0099 5 3 SS013 5 SS013 5 SS012 SS0101 6 SS0100 6 4 SS016 5 SS016 5 SS014 SS0104 6 SS0102 5 SS0098 6 SS015 SS0107 6 SS0103 6 SS0101 6 SS0105 7 SS0104 6 SS0106 8 SS0107 6
Spreadsheet Formulas
Cell Formula B2 =LEN(A2) C2 =B2=5 H2 =B2=6 B3 =LEN(A3) B4 =LEN(A4) B5 =LEN(A5) B6 =LEN(A6) B7 =LEN(A7) B8 =LEN(A8)
Excel tables to the web >> Excel Jeanie HTML 4
Code:Sub main() DM [f2], [e2], [g2] DM [j2], [i2], [k2] End Sub Sub DM(totrange As Range, drng 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(drng.Address, "$")(1) & Rows.count).End(xlUp).Row If lr > 20 Then Exit Sub ReDim a(2 To lr) j = 0 Do j = j + 1 Loop While Not IsNumeric(Mid(drng, j, 1)) And j < 20 j = j - 1 pref = Left(drng, j) mn = 30000: mx = 0 For i = 2 To lr a(i) = Right(Cells(i, drng.Column), Len(Cells(i, drng.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, drng.Column).Value) Then d.Remove Cells(i, drng.Column).Value Next dest.Resize(d.count).Value = WorksheetFunction.Transpose(d.Keys) End Sub
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
This version uses an auxiliary sheet for calculations:
Code:Sub Satv() 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.[a1] 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, drng 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(drng.Address, "$")(1) & Rows.Count).End(xlUp).Row ReDim a(2 To lr) j = 0 Do j = j + 1 Loop While Not IsNumeric(Mid(drng, j, 1)) And j < 20 j = j - 1 pref = Left(drng, j) mn = 30000: mx = 0 For i = 2 To lr a(i) = Right(Cells(i, drng.Column), Len(Cells(i, drng.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, drng.Column).Value) Then d.Remove Cells(i, drng.Column).Value Next dest.Resize(d.Count).Value = WorksheetFunction.Transpose(d.Keys) End Sub
Last edited by Worf; May 25th, 2019 at 11:08 PM.
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
Thanks worf, when I run the above I get 'subscript out of range'?
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
On what code line?
Do you have worksheets named Sheet1 and Plan2, as explained in the code comments?
Excel 2013 / Windows 8.1 (home)
Excel 2013 / windows 7 (work)
Like this thread? Share it with others