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

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

Answer 1

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

Answer 2

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

Answer 3

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