VBA Code to insert row based on 2 different values

[Needinghlp]

Hello. I’m hoping someone may be able to help with some VBA Code for the following. I have searched for similar queries and while I can find things that I think come close to what I want, they aren't quite right and being a novice I’m not good enough to figure this out myself.

As per the image, I have a list of numbers in column a. They will always be in ascending order and unique numbers, no duplicates.

I then have a cell D1 in which I can enter a number, in this example I've entered 18. This number is a variable field.

There are 2 things I would like to be able to do. The first is the essential part and the 2nd is a nice to have.

• When I enter a figure into D1, I would like to be able to click the ‘Insert Row’ button and to automatically find where the value belongs in the list, insert a row in the relevant space and colour that row blue.
• For example, current D1 = 18
• I’d like to be able to click the button and have a blue row inserted between rows 4 & 5.
• 
  
• The nice to have.. If I updated 18 to 25, I’d like to have that blue row deleted from it’s current position and inserted between rows 5 & 6.

Your help would be greatly appreciated.

 

[footoo]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
For Each cel In Intersect([A:A], ActiveSheet.UsedRange)
    If cel.Interior.ColorIndex = 5 Then
        cel.EntireRow.Delete
        Exit For
    End If
Next
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 5
End With
End Sub

OR :

Sub v()
Dim cel As Range
For Each cel In Intersect([A:A], ActiveSheet.UsedRange)
    If cel.Interior.ColorIndex = 5 Then
        cel.EntireRow.Delete
        Exit For
    End If
Next
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 5
End With
End Sub

 

[Needinghlp]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
For Each cel In Intersect([A:A], ActiveSheet.UsedRange)
    If cel.Interior.ColorIndex = 5 Then
        cel.EntireRow.Delete
        Exit For
    End If
Next
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 5
End With
End Sub

OR :

Sub v()
Dim cel As Range
For Each cel In Intersect([A:A], ActiveSheet.UsedRange)
    If cel.Interior.ColorIndex = 5 Then
        cel.EntireRow.Delete
        Exit For
    End If
Next
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 5
End With
End Sub

Thank you so much FooToo. The 2nd one worked really well. One further question.. At the moment, if I have a number in D1 and the blue line has been inserted, but I then delete the number in D1 and D1 remains empty, the blue row is deleted but it returns an error: Run-time error '1004': Unable to get the Match property of the WorksheetFunction class. How could I prevent that error showing? Thanks so much for your help.

 

[footoo]

tRY THIS :

Sub v()
On Error Resume Next
With Application.FindFormat
    .Clear
    .Interior.ColorIndex = 37
    [A:A].Find("", SearchFormat:=True).EntireRow.Delete
    .Clear
End With
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 37
End With
End Sub

 

[Needinghlp]

tRY THIS :

Sub v()
On Error Resume Next
With Application.FindFormat
    .Clear
    .Interior.ColorIndex = 37
    [A:A].Find("", SearchFormat:=True).EntireRow.Delete
    .Clear
End With
With [A:A].Cells(WorksheetFunction.Match([D1], [A:A], 1) + 1).EntireRow
    .Insert
    .Offset(-1).Interior.ColorIndex = 37
End With
End Sub

Magic. I can't thank you enough!