Update numbers
Hi again,
Am Thu, 7 Feb 2019 11:54:49 +0100 schrieb Claus Busch:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C2:C501")) Is Nothing _
Or Target.Count 1 Then Exit Sub
Dim rngC As Range
Dim LRow As Long
LRow = Cells(Rows.Count, 2).End(xlUp).Row
For Each rngC In Range("A2:A" & LRow)
If rngC = Target And rngC < Target.Offset(, -2) Then
rngC = rngC + 1
Next
Target.Offset(, -2) = Target
End Sub
to avoid the loop through all 500 cells:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C2:C501")) Is Nothing _
Or Target.Count 1 Then Exit Sub
Dim first As Integer, last As Integer, i As Integer
first = Application.Match(Target, Range("A1:A501"), 0)
last = Application.Match(Target.Offset(, -2) - 1, Range("A1:A501"), 0)
For i = first To last
Cells(i, "A") = Cells(i, "A") + 1
Next
Target.Offset(, -2) = Target
End Sub
Regards
Claus B.
--
Windows10
Office 2016
|