Auto change number in a column when duplicate number entered-CodePudding

I am try to get a column number to change automatically, by -1, if the same number is entered in the same column again.

Basically I am sorting a list 1 to whatever and then auto sort and change everything below that new number to change by -1. I have the VBA to auto sort as I go but the change in number has me stumped.

Starting point:

If I change D9 to 5 I need it to move into that position (D6) and change D7:D11 by -1

I already have the VBA for the sorting:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:d")) Is Nothing Then
        Range("D1").Sort Key1:=Range("D2"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
End Sub

but really need help with the other.

CodePudding user response：

What you are asking for will work if a cell in column D is changed to a value greater than its current value. It won't work if its changed to a value less than its current value.

Here's a solution that works for both Note: this assumes column D starts out numbered sequentialy from 1 and sorted. If not, you'll get weird results.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim TargetRow As Long, i As Long, lr As Long
    
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        On Error GoTo EH

        TargetRow = Target.Row

        
        Application.EnableEvents = False
        lr = Me.Cells(Me.Rows.Count, 4).End(xlUp).Row
        
        If Target.Value2 >= TargetRow Then
            If Target.Value2 >= lr Then Target.Value2 = Target.Value2 - 1
            
            For i = TargetRow   1 To lr
                Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2 - 1
            Next
        ElseIf Target.Value2 < TargetRow - 1 Then
            If Target.Value2 <= 0 Then Target.Value2 = 1
            
            For i = Target.Value2   1 To TargetRow - 1
                Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2   1
            Next
        
        End If
        Me.Range("D1").Sort Key1:=Me.Range("D2"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, _
          MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
EH:
    Application.EnableEvents = True
End Sub