SOLVED

VBA: Start a new number sequence based on an adjacent cell change

Copper Contributor

Hi Community,

 

I have a macro-enabled document which auto-fills a column entitled "Line Number" (column E) from the number 1 onwards (1, 2, 3, etc). The macro that I recorded to do so first fills the first cell (E3) with the number one, then the cell in the next row (E4) with the number 2, then highlights 1 and 2 and auto-fills down. 

 

 

   Range("E3").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("E3:E4").Select
    Selection.AutoFill Destination:=Range("E3:E" & Range("B" & Rows.Count).End(xlUp).Row)
    Range(Selection, Selection.End(xlDown)).Select

 

 

The problem is that what I actually need to achieve is that the number sequence needs to start again if the value in an adjacent cell changes. 

 

For example:

DateLine Number
01-Dec1
01-Dec2
01-Dec3
02-Dec1
03-Dec1
03-Dec2

 

Please help - how can I achieve this using VBA?

4 Replies

@lnmlilo 

Sub Sequencewithoutformula()

Dim lastrowA, i, j As Long
Range("C3:C1048576").Clear
j = 1
lastrowA = Range("B" & Rows.Count).End(xlUp).Row

For i = 3 To lastrowA

If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
Cells(i, 3).Value = Cells(i + 1, 3).Value + j
j = j + 1
Else
Cells(i, 3).Value = Cells(i + 1, 3).Value + j
j = 1
End If

Next i

End Sub

You can run this macro to start a new number sequence based on adjacent cell change.

sequence of numbers.png

A new sequence of numbers starts even if there are repeating dates such as "01-Dec" in range B3:B5 and B18:B20. However i assume that in the actual database the date column is sorted in ascending order.

best response confirmed by lnmlilo (Copper Contributor)
Solution

@lnmlilo The following procedure loads the data from column D into an array, then loops through each item and assigns the applicable line number to a new array. The results are then output to column E all at once, which is significantly faster than iterating through each cell in a range directly on the worksheet.

 

Sub AssignLineNumber()

'Load the data from column D into an array
    Dim ws As Worksheet, rowCount As Long, data As Variant
    Set ws = Application.ActiveSheet
    rowCount = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row - 2
    data = ws.Range("D3").Resize(rowCount).Value

'Generate line numbers in a new array
    Dim arr() As Variant, i As Long
    ReDim arr(1 To rowCount, 1 To 1)
    arr(1, 1) = 1
    For i = 2 To rowCount
        If data(i, 1) = data(i - 1, 1) Then
            arr(i, 1) = arr(i - 1, 1) + 1
        Else
            arr(i, 1) = 1
        End If
    Next i

'Output the results to column E
    ws.Range("E3").Resize(rowCount).Value = arr

End Sub

 

For more information on VBA arrays, please see: https://excelmacromastery.com/excel-vba-array/ 

Thank you for your prompt response! I have tested this and it works. It's actually great that it starts the sequence again even for repeated dates because different dates belong to different people's timesheets.

Thank you for your prompt response! I have tested this and it works. I had never heard of arrays and the datasets that I am working with can get quite large so it's great to know how to prevent sluggishness when populating the column.

1 best response

Accepted Solutions
best response confirmed by lnmlilo (Copper Contributor)
Solution

@lnmlilo The following procedure loads the data from column D into an array, then loops through each item and assigns the applicable line number to a new array. The results are then output to column E all at once, which is significantly faster than iterating through each cell in a range directly on the worksheet.

 

Sub AssignLineNumber()

'Load the data from column D into an array
    Dim ws As Worksheet, rowCount As Long, data As Variant
    Set ws = Application.ActiveSheet
    rowCount = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row - 2
    data = ws.Range("D3").Resize(rowCount).Value

'Generate line numbers in a new array
    Dim arr() As Variant, i As Long
    ReDim arr(1 To rowCount, 1 To 1)
    arr(1, 1) = 1
    For i = 2 To rowCount
        If data(i, 1) = data(i - 1, 1) Then
            arr(i, 1) = arr(i - 1, 1) + 1
        Else
            arr(i, 1) = 1
        End If
    Next i

'Output the results to column E
    ws.Range("E3").Resize(rowCount).Value = arr

End Sub

 

For more information on VBA arrays, please see: https://excelmacromastery.com/excel-vba-array/ 

View solution in original post