Code fails when generating sequence "Run-time error '9': Subscript out of range"

[mir994stan]

Hello to everyone,
I posted same question here but no response... Code fails when generating sequence "Run-time error '9': Subscript out of range"

I have a macro that generate short sequence of multiple box ID numbers. For example this box numbers: M005203031, M005203032, M005203033, M005268005, M005268006, M005268007, will turn into string like this: M005203031-033 // M005268005-007 and that works perfect! Sometimes i don t have all box numbers incremented by 1, numbers are randomly incremented, and error happends. As i could notice, error happens when next value in sequence is incremented more then 1 (one) compared to the previous value. For example in this case will error pop up: M005203031, M005203032, M005203034, M005203036, M005268006, M005268007. Because xx34+1 isn t equal to xx36. It would be great if this could be fixed.
Here is the code i have for this job. In debug mode this code line is highlighted

sequenceArr(counter) = arr(i + 1)

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 '<<< i think in this line here error is generated
                    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

 

[jimrward]

Where you have …=templastelement
else
counter=counter +1
sequencearr(…..

should it not be …=templastelement
counter=counter +1
else
sequencearr…

 

[johnnyL]

I tend to agree. It looks like your 'counter' is the issue. You are advancing the 'counter' twice in your Else section there.

 

[mir994stan]

I tried your sugestion but, it doesn t fix problem. It just display as result first and last number of string, and nothing in beetwen :/

Where you have …=templastelement
else
counter=counter +1
sequencearr(…..

should it not be …=templastelement
counter=counter +1
else
sequencearr…

 

[mir994stan]

I uploaded workbook sample with codes and raw data. If u guys can someone help me fixt this, it would be great! https://easyupload.io/h9izlu

 

[Fluff]

Try it like

    ReDim sequenceArr(1 To UBound(arr))
    dim Flg as Boolean
    sequenceArr(1) = arr(1)
    counter = 1
            For i = 1 To UBound(arr) - 1
                 If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then
                    If Flg Then
                        counter = counter + 1
                        Flg = False
                    End If
                    tempLastElement = arr(i + 1)
                    sequenceArr(counter) = tempLastElement
             Else
                    Flg = True
                    counter = counter + 1
                    sequenceArr(counter) = arr(i + 1)
            End If
        
    Next

 

[mir994stan]

Try it like

    ReDim sequenceArr(1 To UBound(arr))
    dim Flg as Boolean
    sequenceArr(1) = arr(1)
    counter = 1
            For i = 1 To UBound(arr) - 1
                 If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then
                    If Flg Then
                        counter = counter + 1
                        Flg = False
                    End If
                    tempLastElement = arr(i + 1)
                    sequenceArr(counter) = tempLastElement
             Else
                    Flg = True
                    counter = counter + 1
                    sequenceArr(counter) = arr(i + 1)
            End If
      
    Next

It doesn t display error message anymore, but it create wrong result. I tested it and for values: M004689552, M004704396, M004704399, M004704400, M004704401, M004705802, M004733870 M004736913, M004736914, M004736915 ,M004736916 i get this result: M004689552-396// M004704399-401//M004705802-870//M004736913-916 instead of something like this M004689552 // M004704396 // M004704399-401 // M004705802 // M004733870 // M004736913-916 main task of this code is to join array of box ID numbers and separate different / unique values. In your edited version this result value //M004705802-870// means i have included all box numbers from 5802 to 5870 and it only 2 box numbers...
Thanks for your effort!

 

[Fluff]

It doesn t display error message anymore,

That's what you asked for.

but it create wrong result

I suspected as much.

 

[mir994stan]

That's what you asked for.

I suspected as much.

Hahhah i must agree with you Sir I don't know if you understand what I want to achieve with this, or i need to explain more?

 

[Fluff]

I do understand, what you want, but as that is a completely different question, you will need to start a new thread. Thanks