Ant00x
Ant00x

Reputation: 3

Stop increment value in cell according another value in another cell

According to my precedent post

I need to stop the increment, but I don't find out...

My code:

Range("A2").Value = "1"
Set derlign = Range("B" & Rows.count).End(xlUp)
'MsgBox ("Dernière ligne " & derlign & " !")
Set r1 = Range("A2:A100")
Set r2 = Range("B2:B100")
For N = 2 To r2.Rows.count
    If r2.Cells(N - 1, 1) = r2.Cells(N, 1) Then
       r1.Cells(N, 1) = r1.Cells(N - 1, 1)
    Else
       r1.Cells(N, 1) = r1.Cells(N - 1, 1) + 1
    End If
Next N
End Sub`

but that give me :

N°  REF
1   305-77-871
2   402-88-920
2   402-88-920
3   406-55-585
3   406-55-585
3   406-55-585
4   404-11-885
4   404-11-885
4
4
4
...

Could you help me to stop the increment?

Upvotes: 0

Views: 65

Answers (2)

Pᴇʜ
Pᴇʜ

Reputation: 57683

Your increment stops automatically at r2.Rows.count, so you need to limit your range to the amount of data you have (instead of hard coding 100).

If you tell VBA the range is up to 100 then of course the loop runs to 100. Just use derlign to limit your range to the amount of data you have in column B.

    Set derlign = Range("B" & Rows.count).End(xlUp)
    'MsgBox ("Dernière ligne " & derlign & " !")
    Set r1 = Range("A2:A" & derlign.Row)
    Set r2 = Range("B2:B" & derlign.Row)
    For N = 2 To r2.Rows.count
        If r2.Cells(N - 1, 1) = r2.Cells(N, 1) Then
           r1.Cells(N, 1) = r1.Cells(N - 1, 1)
        Else
           r1.Cells(N, 1) = r1.Cells(N - 1, 1) + 1
        End If
    Next N
End Sub

Actually I would change it to

Option Explicit

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

    Dim LastRow As Long
    LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

    Dim RefData As Variant 'read REF into array
    RefData = ws.Range("B2:B" & LastRow).Value

    Dim NumData As Variant 'read Num into array
    NumData = ws.Range("A2:A" & LastRow).Value

    NumData(1, 1) = 1 'start number

    Dim iRow As Long
    For iRow = LBound(RefData) + 1 To UBound(RefData) 'loop through array
        If RefData(iRow, 1) = RefData(iRow - 1, 1) Then
            NumData(iRow, 1) = NumData(iRow - 1, 1)
        Else
            NumData(iRow, 1) = NumData(iRow - 1, 1) + 1
        End If
    Next iRow

    'write the array back to the cells
    ws.Range("A2:A" & LastRow).Value = NumData
End Sub

Upvotes: 1

DAme
DAme

Reputation: 727

To exit your loop early you can use the instruction 'Exit For'

If [condition] Then Exit For

Upvotes: 0

Related Questions