Combining consecutive values in a column with the help of VBA

Question

I have a data like this :

A049
A050
A051
A053
A054
A055
A056
A062
A064
A065
A066

And I want the output like :

As you can see, I want the ranges which are in consecutive order

I am trying some thing like this:

Private Sub CommandButton1_Click()

    Set wb = ThisWorkbook
    lastRow = wb.Sheets("Sheet1").Range("A" & wb.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        r = wb.Sheets("Sheet1").Range("A" & i).Value

        If wb.Sheets("Sheet1").Range("A" & i).Value = wb.Sheets("Sheet1").Range("A" & i+1).Value
    Next i
End Sub

But not helping me

Your code can't work. Your `If` statement is missing a `Then` some statement what to do if true and `End If`. — Pᴇʜ, Jan 25 '18 at 09:05
Where did A050 go in your image ? Can't find the logic behind this — Rafalon, Jan 25 '18 at 09:05
@Peh : i dont know what will be after If, hence i have left it blank — urvashi, Jan 25 '18 at 09:07
@Rafalon : A050 is in between A049 and A051. i want only the lower bound and upper bound values — urvashi, Jan 25 '18 at 09:10
@urvashi How do you decide which lower bound and upper bound values you want in a row? — Xabier, Jan 25 '18 at 09:12
@Xabier there is a gap between `A051` and `A053` so they are not consecutive that makes it start a new row. That's how I understand the question. — Pᴇʜ, Jan 25 '18 at 09:13
@Xabier- where there is a run of consecutive numbers he wants the first number in column A and the last number in column B. urvashi - what have you tried - anything? — SJR, Jan 25 '18 at 09:13
@Xabier : i want something like which starts from A049(lower bound), determine till where the consecutive value is, here for eg: A051..which will be upper bound. then go to the next cell,A053, which will automatically become lower bound..and so on — urvashi, Jan 25 '18 at 09:14
@SJR : you are very correct. no i am actually very confused, how to proceed — urvashi, Jan 25 '18 at 09:15
Do all your codes consist of a letter followed by three numbers or can they vary? — SJR, Jan 25 '18 at 09:20

score 0 · Answer 1 · answered Jan 25 '18 at 09:31

Try the below code

Private Sub CommandButton1_Click()

    Set wb = ThisWorkbook
    lastRow = wb.Sheets("Sheet1").Range("A" & wb.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    Dim lastNum, Binsert As Integer
    Dim firstCell, lastCell, currentCell As String
    Binsert = 1
    lastNum = getNum(wb.Sheets("Sheet1").Range("A1").Value)
    firstCell = wb.Sheets("Sheet1").Range("A1").Value
    For i = 2 To lastRow
        activeNum = getNum(wb.Sheets("Sheet1").Range("A" & i).Value)
        currentCell = wb.Sheets("Sheet1").Range("A" & i).Value
        If (activeNum - lastNum) = 1 Then
            'nothing
        Else
            lastCell = wb.Sheets("Sheet1").Range("A" & (i - 1)).Value
            wb.Sheets("Sheet1").Range("B" & Binsert).FormulaR1C1() = firstCell
            If (firstCell <> lastCell) Then
                wb.Sheets("Sheet1").Range("C" & Binsert).FormulaR1C1() = lastCell
            End If
            Binsert = Binsert + 1
            firstCell = wb.Sheets("Sheet1").Range("A" & i).Value
        End If
        lastNum = activeNum
    Next i
    'last entry
    wb.Sheets("Sheet1").Range("B" & Binsert).FormulaR1C1() = firstCell
    If (firstCell <> currentCell) Then
        wb.Sheets("Sheet1").Range("C" & Binsert).FormulaR1C1() = currentCell
    End If
End Sub
Public Function getNum(ByVal num As String) As Integer
    getNum = Val(Mid(num, 2))
End Function

When you `Dim lastNum, Binsert As Integer` only `Binsert` is Integer but `lastNum` is Variant. You need to specify a type for every variable `Dim lastNum As Long, Binsert As Long`. Also I recommend always to use Long instead of Integer. — Pᴇʜ, Jan 25 '18 at 09:41
Thanks @Peh Noted. However since the data posted by OP shows only integer values, I have used Integer. — , Jan 25 '18 at 09:43
Integer does not make much sense in VBA: For your interest you may read https://stackoverflow.com/a/26409520/3219613 — Pᴇʜ, Jan 25 '18 at 09:44

SJR · Accepted Answer · 2018-01-25T09:54:41.593

0

Am feeling charitable so have tried some code which should work. It assumes your starting values are in A1 down and puts results in C1 down.

Sub x()

Dim v1, v2(), i As Long, j As Long

v1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value

ReDim v2(1 To UBound(v1, 1), 1 To 2)

For i = LBound(v1, 1) To UBound(v1, 1)
    j = j + 1
    v2(j, 1) = v1(i, 1)
    If i <> UBound(v1, 1) Then
        Do While Val(Right(v1(i + 1, 1), 3)) = Val(Right(v1(i, 1), 3)) + 1
            i = i + 1
            If i = UBound(v1, 1) Then
                v2(j, 2) = v1(i, 1)
                Exit Do
            End If
        Loop
    End If
    If v1(i, 1) <> v2(j, 1) Then v2(j, 2) = v1(i, 1)
Next i

Range("C1").Resize(j, 2) = v2

End Sub

edited Jan 25 '18 at 09:54

answered Jan 25 '18 at 09:32

SJR

22,986
6
18
26

Yes, thanks for accepting the answer, but I don't think you should as had missed that. I'll take a look and revise the code. – SJR Jan 25 '18 at 09:44
Bit of a hack but I have amended the code and think it now works correctly. – SJR Jan 25 '18 at 09:54

score 0 · Answer 3 · answered Jan 25 '18 at 09:38

Another solution. It loops backwards from last row to first row.

Option Explicit

Public Sub FindConsecutiveValues()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim lRow As Long 'find last row
    lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    Dim lVal As String 'remember last value (stop value)
    lVal = ws.Range("A" & lRow).Value

    Const fRow As Long = 2 'define first data row
    Dim i As Long
    For i = lRow To fRow Step -1 'loop from last row to first row backwards
        Dim iVal As Long
        iVal = Val(Right(ws.Range("A" & i).Value, Len(ws.Range("A" & i).Value) - 1)) 'get value of row i without A so we can calculate

        Dim bVal As Long
        bVal = 0 'reset value
        If i <> fRow Then 'if we are on the first row there is no value before
            bVal = Val(Right(ws.Range("A" & i - 1).Value, Len(ws.Range("A" & i - 1).Value) - 1)) 'get value of row i-1 without A
        End If

        If iVal - 1 = bVal Then
            ws.Rows(i).Delete 'delete current row
        Else
            If lVal <> ws.Range("A" & i).Value Then 'if start and stop value are not the same …
                ws.Range("B" & i).Value = lVal 'write stop value in column B
            End If
            lVal = ws.Range("A" & i - 1).Value 'remember now stop value
        End If
    Next i
End Sub

Combining consecutive values in a column with the help of VBA

3 Answers3

Linked

Related