How to exctract first and last numbers in a sequence

user_16449971 0
Viewed 87

i foung similiar topic, but i can t apply completily that solution to my needs... I want to upgrade excel workbook at my job by making it more auto-entry capable. Mostly i use excel functions, but sometimes i need some VBA coding, which im not very familiar with. So my problem is, that i need something like this mentioned on this thread. How to get the first and last numbers in a sequence I have box numbers in different sequince in ascening order starting from "A4" to X on Sheet1. Example Box numbers: M004935149,M004935150,M004935151,M004935202,M004935203,M004935204,M004935205, is it possible when i copy&paste(values) to sheet2 from "A4" to X (depenting on number of boxes copied) to make a string, sentence or whatever is called in specific form in some other cells. M004935149-151 // M004935202-205. I used code from topic in link above, it can make half job done but i can t figure it out how to make entry from desired cell range and display them on worksheet, and to display values in desired format. Link of screen shoots from my example is following:

enter image description here

I hope that someone can help. Thanks in advance.

sequence vba excel arrays
1 Answers

Check this

Option Explicit
Sub test2()
    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("Sheet1")
    firstColumn = 1 'number of first column with target data
    targetRow = 1 'number of row with target data
    
    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) 'if count of character in start of string will be more 1, replace 1 on to count of characters
    For i = 1 To UBound(arr)
        cellValue = ws.Cells(targetRow, i).Value
        arr(i) = Right(cellValue, Len(cellValue) - 1) 'if count of character in start of string will be more 1, replace 1 on to count of characters
    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)
            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("D4").Value = result
End Sub

Result on screenshot

user_114244880
Related