I have in principle two colums A and B. In column A I have continuous numbers, from 1 to 500. In Column B I havce names. Something like

1 Brian
2 James
3 Maria
4 Victoria
5 Henning
6 Rita
..
..
..

ans so on. What I like is to be able to type a new number for one of the names, and have the rest of the numbers change automatically in accordance, like:

If I type 2 next to Rita, the number next to James should change to 3, maria 4, and so on.

next the list must be sorted in the new order, which already works fine, but I can't get the autoreumbering to work.

I try to use the Worksheet_Change event onthe A-column, ad i does change the numbers, but unfortunately these changes triggers the events once again, and that is not the idea. I ha ve tird usen the C column to type the new number, iike

No. Name
1 Brian
2 James
3 Maria
4 Victoria
5 Henning
6 Rita 2

and use the Worksheet_Change event on that column. In my code I have something like

If Not Intersect(Target, Range("C2:C501) Is Nothing Then
For Each c in Range(A2:A501).Cells
If c.Value < target.Value then
c.Value = c.Value + 0
Elseif c.Value Target.Value
c.value = c.Value + 0
Else
c.Value = c.Value + 1
End If
Next
End if

but I can't get it to work as it creates a list like this

0 Brian
3 James
4 Maria
5 Victoria
6 Henning
3 Rita

and the following nunmbers are chanbged as well even if no number seven or higher should change.

any ideas on how to accomplish what i want?

Jan

Hi Jan,

Am Thu, 7 Feb 2019 02:34:38 -0800 (PST) schrieb :

I have in principle two colums A and B. In column A I have continuous numbers, from 1 to 500. In Column B I havce names. Something like

1 Brian
2 James
3 Maria
4 Victoria
5 Henning
6 Rita
.
.
.

ans so on. What I like is to be able to type a new number for one of the names, and have the rest of the numbers change automatically in accordance, like:

If I type 2 next to Rita, the number next to James should change to 3, maria 4, and so on.

try:

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


Regards
Claus B.
--
Windows10
Office 2016

torsdag den 7. februar 2019 kl. 11.34.46 UTC+1 skrev :
I have in principle two colums A and B. In column A I have continuous numbers, from 1 to 500. In Column B I havce names. Something like

1 Brian
2 James
3 Maria
4 Victoria
5 Henning
6 Rita
.
.
.

ans so on. What I like is to be able to type a new number for one of the names, and have the rest of the numbers change automatically in accordance, like:

If I type 2 next to Rita, the number next to James should change to 3, maria 4, and so on.

next the list must be sorted in the new order, which already works fine, but I can't get the autoreumbering to work.

I try to use the Worksheet_Change event onthe A-column, ad i does change the numbers, but unfortunately these changes triggers the events once again, and that is not the idea. I ha ve tird usen the C column to type the new number, iike

No. Name
1 Brian
2 James
3 Maria
4 Victoria
5 Henning
6 Rita 2

and use the Worksheet_Change event on that column. In my code I have something like

If Not Intersect(Target, Range("C2:C501) Is Nothing Then
For Each c in Range(A2:A501).Cells
If c.Value < target.Value then
c.Value = c.Value + 0
Elseif c.Value Target.Value
c.value = c.Value + 0
Else
c.Value = c.Value + 1
End If
Next
End if

but I can't get it to work as it creates a list like this

0 Brian
3 James
4 Maria
5 Victoria
6 Henning
3 Rita

and the following nunmbers are chanbged as well even if no number seven or higher should change.

any ideas on how to accomplish what i want?

Jan

Thank yo,u Claus

it works perfectly.

Jan

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

torsdag den 7. februar 2019 kl. 12.05.41 UTC+1 skrev Claus Busch:
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

Even better. Thank you.

Jan