Thread: Update numbers
View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default 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