How to increment Numbers With Decimals and Restart Numbering When Number Changes?

Question

I want to increment the decimal part of a number and restart numbering every time the number changes as below

    1.00
    1.01
    1.02
    1.03
    1.04
    1.05
    2.00 'Restart With 2
    2.01
    3.00 'Restart With 3
    3.01
    3.02
    3.03

I used the following Code

    Sub AutoNumberDecimals()
    Dim Rng, C As Range
    Dim Lrow As Long
    Dim i As Integer
    Lrow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Worksheets("Union").Range("A2:A" & Lrow)
    For Each C In Rng.Cells
    If C.Value = "" And C.Offset(0, 1).Value = "" Then
    C.Offset(1, 0).Value = C.Value + 0.01
    Next C
    End Sub

But It did not work

Appreciate your help

Thanks, Regards

Your question is not clear (for me, at least...). What initially is on the sheet? Only 1, 2, 3 followed by empty cells, where the decimals to be incremented? Even if the above assumption is correct, when the incrementing of the last number will be stopped? Is it a maximum number incrementing times? — FaneDuru, Aug 10 '20 at 09:44
@ FaneDuru, The Column have Fixed Numbers Like 1,2,3 and Blank cells under each number in which I want to take the previous cell number and add .01, 0.2, 0.3 until we reach the next number and restart the process again. — Meho2016, Aug 10 '20 at 10:08
But you did not clarify my last question? For the last number (3 in your case) when the iteration to be stopped, in order to avoid an infinite loop, searching for a following number? I can post a piece of code but this issue is not clarified. Anyhow, I will post it and I will create a variable to set maximum increment times... — FaneDuru, Aug 10 '20 at 10:12
You have debugged your code? What did it do what you don't understand? **"But It did not work"* is really not helpfull. And if you do `If C.Value = ""`, then `C.Value + 0.01` will always be `0.01`. — FunThomas, Aug 10 '20 at 10:15
Sidenote, you currently get last used row of the active sheet, only then you are using proper qualifications to assing `rng`. — JvdV, Aug 10 '20 at 10:20

FaneDuru · Answer 1 · 2020-08-10T10:53:35.470

Try the next code, please. It uses maxIncr variable to set a maximum incrementing times:

Sub IncrementingRoots()
 Dim sh As Worksheet, lastR As Long, maxIncr As Long
 Dim NrI As Long, i As Long, j As Long
 
 Set sh = ActiveSheet: maxIncr = 7
 lastR = sh.Range("A" & Rows.count).End(xlUp).Row

 For i = 2 To lastR + maxIncr
    If sh.Range("A" & i).Value <> "" Then
        NrI = sh.Range("A" & i).Value
        For j = 1 To maxIncr
            If sh.Range("A" & i + j).Value = Empty Then
                sh.Range("A" & i + j).Value = sh.Range("A" & i + j - 1).Value + 0.01
            Else
                i = j + i - 1: Exit For
            End If
        Next
    End If
    If i > lastR Then Exit For
 Next i
End Sub

And the next code is yours adapted to work. But impossible to procress the last number in the range, too, without something more (like maxIncr in my above code)...

 Sub AutoNumberDecimals()
    Dim sh As Worksheet, Rng As Range, C As Range, Lrow As Long, i As Long
    Set sh = ActiveSheet 'Worksheets("Union")
    Lrow = sh.cells(Rows.count, 1).End(xlUp).Row

    Set Rng = sh.Range("A2:A" & Lrow)
    For Each C In Rng.cells
        If C.Value = "" And (C.Offset(1, 0).Value <> _
             Int(C.Value Or C.Offset(1, 0).Value = "")) Then
           C.Value = C.Offset(-1, 0).Value + 0.01
        End If
    Next C
 End Sub

@Meho2016: Glad I could help! But, we here when somebody answer our question, tick the code left side check box, in order to make it **accepted answer**. In this way, somebody else searching for a similar solution will know that the code works... — FaneDuru, Aug 10 '20 at 10:37

score 0 · Answer 2 · answered Aug 10 '20 at 10:32

I wrote this code. Make sure to add it in Sheet1 module (or similar sheet). It reacts when you enter a number in column 1 and it renumbers all numbers in that column. If you enter 1, it shows 1.00... if you enter 1 again, it will show 1.01. If you enter 2 you will have 2.00 etc...

Private ChangingValues As Boolean

Private Sub RenumFirstColumn()
    Dim RowNo As Integer
    Dim Major As Integer
    Dim Minor As Integer
    Dim CurrentValue As String

    RowNo = 1
    Major = 1
    Minor = 0
  
    Do
        CurrentValue = CStr(Cells(RowNo, 1).Value)
        If Int(Val(Left(CurrentValue, 1))) = Major Then
            CurrentValue = CStr(Major) & "." & Format(Minor, "00")
            Minor = Minor + 1
            If Minor > 99 Then
                MsgBox "To high value (> X.99)"
                Exit Sub
            End If
        Else
            Major = Val(Left(CurrentValue, 1))
            Minor = 0
            CurrentValue = CStr(Major) & "." & Format(Minor, "00")
            Minor = Minor + 1
        End If
        Cells(RowNo, 1).NumberFormat = "@"
        Cells(RowNo, 1).Value = CurrentValue
        RowNo = RowNo + 1
    Loop Until IsEmpty(Cells(RowNo, 1))
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And ChangingValues = False Then
        ChangingValues = True
        RenumFirstColumn
        ChangingValues = False
    End If
End Sub

Hope it was what you were looking for

score 0 · Answer 3 · answered Aug 10 '20 at 11:50

This uses DataSeries and NumberFormat to fill the cells.

This creates a random board, and isn't necessary to the main code.

Cells.Clear
Cells(1, 1) = 1 ' creates a random board
x = 2
For i = 2 To 20
If Rnd() > 0.8 Then
Cells(i, 1) = x
x = x + 1
End If
Next i
Cells(21, 1) = 0 ' terminates entries

Note that rather than determine the row column length using code, I have preset it to 21, although you can use the terminating 0.00 value to define a column length.

The main code:

Range("a:a").NumberFormat = "0.00"
For i = 1 To 21 ' loops through range
j = 0 ' finds local range
If Cells(i, 1) <> "" And Cells(i, 1) > 0 Then
Do
j = j + 1
Loop While Cells(i + j, 1) = ""
End If
Range(Cells(i, 1), Cells(i + j - 1, 1)).DataSeries Type:=xlLinear, Step:=0.01
i = i + j ' jumps to next entry
Next i

Each cell is formatted into the desired style. Then the loop finds a non-empty cell, and determines the associated local subrange by checking if the next cell down is empty or not, and continues until it isn't. Then the subrange is formatted using DataSeries with a Step of 0.01.

Ref:

https://learn.microsoft.com/en-us/office/vba/api/excel.range.dataseries

How to increment Numbers With Decimals and Restart Numbering When Number Changes?

3 Answers3