根据用户动态更改值分配优先级 excel vba

Question

I have list courses in cell b and their respective priorities in cell c from 1 to 49. what I want is if a user changes any value of the priority column ie "C". then all other priority should be adjusted accordingly. logic can be seen in the attached sheet. the priority numbers should change dynamically as the user enters the value. so in example one referring column L in the attached sheet. if user change the no 4 priority to 8 then the rest will go one down . similarly now we have got new nos list. so if any other number changes then it should adjust accordingly,keeping in mind the new list sheet snapshot attached

Tried the below code but it always starts with the value 1 again. So the values are not adjusted based on new list.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
Dim iCount As Long

Dim cell As Range
Dim myRange As Range
Set myRange = Worksheets("Sheet1").Range("C1:C49")

If Intersect(Target, Range("C1:C49")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

myVal = Target.Value
iCount = 1
For Each cell In myRange
    If Intersect(Target, cell) Is Nothing Then
        If iCount = myVal Then
            iCount = iCount + 1
        End If
        cell.Value = iCount
        iCount = iCount + 1
    End If
Next cell


Application.EnableEvents = True

End Sub

Answer 1

Edited to work when first row is any row

The following was generated ...

from this code ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ExtVal As Variant, InsVal As Variant
Dim iLoop As Long
Dim InsRow As Long, ExtRow As Long
Dim foundArr() As Boolean

Dim myRange As Range

    ' initial settings
    Set myRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim foundArr(1 To myRange.Rows.Count)
    For iLoop = 1 To myRange.Rows.Count
        foundArr(iLoop) = False
    Next iLoop

    If Intersect(Target, myRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

    ' calculate the extracted value - the user entered value
    ExtVal = Target.Value
    ' calculate the inserted value - the number the user typed over
    For iLoop = 1 To myRange.Rows.Count
        foundArr(myRange.Cells(iLoop, 1).Value) = True
    Next iLoop
    For iLoop = 1 To myRange.Rows.Count
        If Not foundArr(iLoop) Then
            InsVal = iLoop
            Exit For
        End If
    Next iLoop

    ' calculate the insertion row - the row the user typed in.
    InsRow = CLng(Right(Target.Address, 1))
    ' calculate the extraction row - the original row of the number the user typed
    ExtRow = 0
    For iLoop = 1 To myRange.Rows.Count
        If myRange.Cells(iLoop, 1).Value = ExtVal And myRange.Cells(iLoop, 1).Row <> InsRow Then
            ExtRow = myRange.Cells(iLoop, 1).Row
            Exit For
        End If
    Next iLoop

    ' do the swap / shuffle
    Application.EnableEvents = False

    For iLoop = myRange.Rows.Count To 1 Step -1
        Debug.Print "Evaluating Row " & myRange.Cells(iLoop, 1).Row
        If (myRange.Cells(iLoop, 1).Row <= ExtRow) Then
            If myRange.Cells(iLoop, 1).Row > InsRow + 1 Then
                myRange.Cells(iLoop, 1).Value = myRange.Cells(iLoop - 1, 1).Value
            Else
                If myRange.Cells(iLoop, 1).Row = InsRow + 1 Then
                    myRange.Cells(iLoop, 1).Value = InsVal
                End If
            End If
        End If
    Next iLoop

    Application.EnableEvents = True
End Sub