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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.