Macro fails to separate sequences when some values are random - excel

Question

as a beginner in VBA programming I have a hard time figuring out what the problem is. The code works perfectly when the values ​​increase in order, but when there are values ​​in the array that are not similar then I get an error.
When the problematic values ​​are loaded, an error occurs Run time error 9, subscript out of range and this line is highlighted in the code sequenceArr(counter) = arr(i + 1) The main task of the code is to make short notations of long strings of numbers and to make a separation between different strings.
For example: i have box ID numbers: M0054515, M0054516, M0054517, M0054620, M0054621, M0054622, M0054751, M0054752, M0054753
When i run macro i get output result like this:
M0054515-517 // M0054620-622 // M0054751-753.
But when i have some random numbers in middile of ID number series i get an error... M0046552, M0047396, M0047399, M0047802, M0047803 instead of separated values i get run time error message.
At this link is an example version of my book, if anyone wants to help solve the problem.
For this job I use this code written a long time ago by another member of this forum
Sub Generate()
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

Answer 1

Please, try the next updated code. Since you did not answer my clarification question, I (only) hope that I could deduce what you want accomplishing...
Sub Generate()
Dim ws As Worksheet
Dim arr, sequenceArr, letter As String, cellValue As String, tempLastElement As String
Dim lastColumn As Long, counter As Long, firstColumn As Long, targetRow As Integer, i As Long, j As Long
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))
counter = 1
For i = 1 To UBound(arr) - 1
If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then
For j = 0 To UBound(arr)
If i + j + 1 > UBound(arr) Then Exit For
If CLng(arr(i)) + j + 1 = CLng(arr(i + 1 + j)) Then
tempLastElement = arr(i + 1 + j)
Else
Exit For
End If
Next j
sequenceArr(counter) = arr(i) & "-" & Right(tempLastElement, 3)
counter = counter + 1: i = i + j
Else
sequenceArr(counter) = arr(i): counter = counter + 1
End If
Next
ReDim Preserve sequenceArr(1 To counter - 1)
ws.Range("C4").Value = letter & Join(sequenceArr, "//" & letter)
MsgBox "Success!"
End Sub
A more compact version, working with 0 based arrays:
Sub Generate2()
Dim ws As Worksheet
Dim arr, sequenceArr, letter As String, cellValue As String, tempLastElement As String
Dim lastColumn As Long, counter As Long, firstColumn As Long, targetRow As Integer, i As Long, j As Long
Set ws = Worksheets("KreirajRadniNalog")
firstColumn = 1: targetRow = 1
lastColumn = ws.Range(ws.Cells(targetRow, firstColumn), ws.Cells(targetRow, Columns.Count).End(xlToLeft).Columns).Count
letter = Left(ws.Cells(targetRow, firstColumn).Value, 1)
With Application
arr = .Transpose(.Transpose(ws.Range(ws.Cells(targetRow, firstColumn), ws.Cells(targetRow, lastColumn)).Value))
End With
arr(1) = Mid(arr(1), 2)
arr = Split(Join(arr, "|"), "|" & letter)
ReDim sequenceArr(UBound(arr))
counter = 0
For i = 0 To UBound(arr) - 1
If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then
For j = 0 To UBound(arr)
If i + j + 1 > UBound(arr) Then Exit For
If CLng(arr(i)) + j + 1 = CLng(arr(i + 1 + j)) Then
tempLastElement = arr(i + 1 + j)
Else
Exit For
End If
Next j
sequenceArr(counter) = arr(i) & "-" & Right(tempLastElement, 3)
counter = counter + 1: i = i + j
Else
sequenceArr(counter) = arr(i): counter = counter + 1
End If
Next
ReDim Preserve sequenceArr(1 To counter)
ws.Range("C4").Value = letter & Join(sequenceArr, "//" & letter)
MsgBox "Success!"
End Sub

Answer 2

The problem with your code is here
Else
counter = counter + 1
sequenceArr(counter) = arr(i + 1) '<<<this line here is highlighted
counter = counter + 1
End If
because for every single number the counter is incremented twice and so exceeds the array size. However you don't really need arrays
Sub Generate()
Dim ws As Worksheet, arr
Dim lastColumn As Long, letter As String, tmp As String
Dim result As String, i As Long, m As Long, n As Long
Set ws = Worksheets("KreirajRadniNalog")
Const firstColumn = 1
Const targetRow = 1
lastColumn = ws.Cells(targetRow, Columns.Count).End(xlToLeft).Column
arr = ws.Cells(targetRow, 1).Resize(, lastColumn)
result = arr(1, 1)
m = Mid(arr(1, 1), 2)
For i = 2 To UBound(arr, 2)
n = Mid(arr(1, i), 2)
If n = m + 1 Then
tmp = "-" & Right(Val(Mid(arr(1, i), 2)), 3)
Else
result = result & tmp & "//" & arr(1, i)
tmp = ""
End If
m = n
Next
result = result & tmp
ws.Range("C4").Value = result
End Sub