VBA Code to insert row based on 2 different values

Needinghlp

New Member
Joined
Feb 27, 2013
Messages
19
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.
1610092425457.png
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,206
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
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 :
VBA Code:
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

New Member
Joined
Feb 27, 2013
Messages
19
VBA Code:
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 :
VBA Code:
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

Well-known Member
Joined
Sep 21, 2016
Messages
3,206
Office Version
  1. 2016
Platform
  1. Windows
tRY THIS :
VBA Code:
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

New Member
Joined
Feb 27, 2013
Messages
19
tRY THIS :
VBA Code:
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,127,846
Messages
5,627,235
Members
416,232
Latest member
Ash1432

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top