Macro to display the first and last number in a sequence of numbers increased by 1

mir994stan

New Member
Joined
Jul 18, 2021
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
I started a new topic because the moderator suggested it to me. You can see the old one at this link. Old topic
I have a problem with the code I am currently using to make a short string of box numbers that I use in shipping. Instead of writing all the box numbers, I write from the first to the last and the minus sign indicates all the boxes in between. The code works perfectly in most cases, but if there are several consecutive unique numbers I get an run time error 9 Subscript out of range because it cannot make a sequence with them. For each box I own I have ID numbers that increase in ascending order. If I have 50 boxes and the first one starts with the number M00100 and each subsequent number is incremented by the 1. Code instead of writing all the numbers from M00100 to M00150 it should write M00100-150 as a result. And if there is an interrupt in the array of those 50 boxes, it should mark each interrupt with // and start checking the array again. Any number that cannot be incremented by 1 must be interrupted by //

I would be very grateful if someone could help. Thanks in advance!

This is my current code:

VBA Code:
Sub Generisi()


Dim ws As Worksheet
    Dim arr() As String, result As String, letter As String, cellValue As String, tempLastElement As String
    Dim lastColumn As Long, counter As Long
    Dim firstColumn As Integer, targetRow As Integer, i As Integer
    Set ws = Worksheets("KreirajRadniNalog")
    firstColumn = 1
    targetRow = 1
    
    lastColumn = ws.Range(ws.Cells(targetRow, firstColumn), ws.Cells(targetRow, Columns.Count).End(xlToLeft).Columns).Count
    ReDim arr(1 To lastColumn - firstColumn + 1)
    letter = Left(ws.Cells(targetRow, firstColumn).Value, 1)
    For i = 1 To UBound(arr)
        cellValue = ws.Cells(targetRow, i).Value
        arr(i) = Right(cellValue, Len(cellValue) - 1)
    Next i
    
    ReDim sequenceArr(1 To UBound(arr))
    sequenceArr(1) = arr(1)
    counter = 2
            For i = 1 To UBound(arr) - 1
                 If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then 
                    tempLastElement = arr(i + 1)
                    sequenceArr(counter) = tempLastElement
             Else
                    counter = counter + 1
                    sequenceArr(counter) = arr(i + 1) '<<<this line here is highlighted
                    counter = counter + 1
            End If
        
    Next
    ReDim Preserve sequenceArr(1 To counter)
    result = ""
    counter = 1
    For i = 1 To UBound(sequenceArr) - 1
        If counter > UBound(sequenceArr) Then Exit For
        If result = "" Then
            result = letter & sequenceArr(counter) & "-" & Right(sequenceArr(counter + 1), 3)
            counter = counter + 2
        Else
            result = result & "//" & letter & sequenceArr(counter) & "-" & Right(sequenceArr(counter + 1), 3)
            counter = counter + 2
        End If
    Next
    ws.Range("C4").Value = result
    
    
    
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
58,348
Office Version
  1. 365
Platform
  1. Windows
Would that -6 represent 16, 26,36, etc?
Seems logical to me that one digit would replace one digit.
Otherwise
M004736913-916
could represent
M004736913 to M004736916
or
M004736913 to M004737916
or ...
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
58,348
Office Version
  1. 365
Platform
  1. Windows
The file was then edited.
Presumably by you(?) to provide sample data on behalf of the OP or is it a file that contains a suggested solution, or something else?
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Sorry @Peter_SSs, I am confused.

The link to to the file I just posted is a file that the OP originally posted in the previous thread that I linked to. I then modified that file and posted a new link to that modified file. Sorry for any confusion I may have caused. I didn't alter any of the data in the file.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
For the other people that want to play without downloading the file:

Sampe workbook for testingV2 .xlsm
ABCDEFGHIJK
1M004689552M004704396M004704399M004704400M004704401M004705802M004733870M004736913M004736914M004736915M004736916
2
3()          
4 Broj serije()//M004689552//M004704396//M004704399-4401//M004705802//M004733870//M004736913-6916//M004689552//M004704396//M004704399-4401//M004705802//M004733870//M004736913-6916 Broj serije()
5
6Generated string
7
8
9IDPaste serial number hereSerija//M004689552//M004704396//M004704399-4401//M004705802//M004733870//M004736913-6916 Broj serije()
10
11
12Serial numbers for testing
13
14M004625090
15M004625091
16M004625092
17M004625093
18M004625094
19M004625095
20M004631989
21M004631990
22M004631991
23M004631992
24M004632055
25M004670709
26M004670710
27M004670711
28M004689552
29M004704396
30M004704399
31M004704400
32M004704401
33M004705802
34M004733870
35M004736913
36M004736914
37M004736915
38M004736916
39M004736936
40M004736937
41M004736938
42M004744168
43M004744169
44M004744170
45M004744171
46M004744172
47M004744173
48M004744174
49M004744175
50M004744176
51M004744177
52M004744178
53M004744179
54M004744180
55M004744181
56M004744182
57M004744183
58M004744184
59M004746760
60M004746761
61M004746762
62M004746763
63M004746764
64M004746765
65M004746766
66M004746767
67M004746768
68M004746769
69M004746770
70M004746771
71M004746772
72M004746773
73M004746774
74M004746775
75M004746776
76M004746777
77M004746778
78M004746779
79M004749628
80M004749629
81M004749630
82M004749631
83M004749632
84M004749633
85M004749634
86M004749635
87M004749636
88M004749637
89M004749638
90M004749639
91M004749640
92M004749641
93M004749642
94M004749643
95M004749644
96M004749645
97M004749646
98M004749647
99M004754235
100
KreirajRadniNalog
Cell Formulas
RangeFormula
B3:K3B3=IF(B2=0,"",IF(C2>0,B2&",",B2&")"))
A3A3=IF(B$2>0,"("&A2&",","("&A2&")")
A4A4=" "&"Broj serije"&A3&B3&C3&D3&E3&F3&G3&H3&I3&J3&K3&L3&M3&N3&N3&N3&N3&O3&P3&Q3&R3&S3&T3&U3&V3&W3&X3&Y3&Z3&AA3&AB3
F4F4=C4&A4
 

mir994stan

New Member
Joined
Jul 18, 2021
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
According to your file you uploaded ... would the following F9 result be acceptable? :

VBA Code:
//M004689552//M004704396//M004704399-401//M004705802//M004733870//M004736913-916  Broj serije()
Yes, that's it! Great job.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Presumably by you(?) to provide sample data on behalf of the OP or is it a file that contains a suggested solution, or something else?
Sorry @Peter_SSs, after a good night sleep, I see what you were asking now.

The file was shortened and code was altered for a solution. The data was not altered.
 

mir994stan

New Member
Joined
Jul 18, 2021
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Will it always be 3 digits after the dash?
Or could it be that you had
M004704998, M004704999,M004705000,M004705001 meaning you might need 4 digits after the dash in your summary?
M004704998-5001

If it is not always 3, then instead of
M004736913-916
could we just have this?
M004736913-6
We use 3 last digits, because based on the full ID number of the first box we can determine which boxes it is, and the number behind the line indicates to which box the numbers go. But 4 digits are fine also.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
@mir994 the file I uploaded allows you to set the number of digits you want to display on the end, be it 3 or 4 or whatever.
 

mir994stan

New Member
Joined
Jul 18, 2021
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Great job
Sorry @Peter_SSs, after a good night sleep, I see what you were asking now.

The file was shortened and code was altered for a solution. The data was not altered.
@johnnyL Great job, I saw how you managed to sort the code. I hope you had no problem handling the macro buttons. And the formulas in the cells may be stupid :) but they save me time.
 

Forum statistics

Threads
1,186,004
Messages
5,955,264
Members
438,188
Latest member
DLJ

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
Top