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

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

CodePudding user response：

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

CodePudding user response：

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