Getting numbers to automatically move up when inserting lines - vba

Question

Currently working on an excel sheet to rank projects, we would like it to automatically increase the numbers if we insert a new line and input an existing number rank. If we put in a line and type in 9 for its rank we want the pre existing 9 to move to 10 and the old 10 to move to 11 etc. I have kind of worked it out, however my code automatically numbers the first row as 1 and so forth. This is what I have so far.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
I = 1
Application.EnableEvents = False
For I = 1 To 20
Range("A" & I).Value = I
Next
Range("A21").Value = ""
Application.EnableEvents = True
End Sub

Answer 1

You could loop through every cell in column A and, if its value is greater than (or equal to) the one just changed, increment it by one:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim v As Long
Dim r As Range
Set r = Application.Intersect(Range("A:A"), Target)
If r Is Nothing Then
Exit Sub
End If
If r.Count > 1 Then
Exit Sub
End If
If IsEmpty(r.Value) Then
Exit Sub
End If
I = 1
v = r.Value
If Application.CountIf(Range("A:A"), v) > 1 Then ' Only change things if this
' value exists elsewhere
Application.EnableEvents = False
For I = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(I, "A").Address <> r.Address Then
If IsNumeric(Cells(I, "A").Value) Then ' skip cells that aren't numeric
If Cells(I, "A").Value >= v Then
Cells(I, "A").Value = Cells(I, "A").Value + 1
End If
End If
End If
Next
Application.EnableEvents = True
End If
End Sub