Inserting a blank shaded row at change in data

[scoha]

I have code that I want to sort labels in ColA and at every change in label it inserts a new blank row and shades it grey.

Here is where Ive got to but it doesnt shade and doesnt clear formula or dta validation that was in the row above prior to insert.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim r As Range
Dim LR As Long, i As Long

  Set r = Intersect(Target, Range("a7:a" & Rows.Count))
  If r Is Nothing Or Target.Count > 1 Then Exit Sub
  
  On Error GoTo EndNow
  Application.EnableEvents = False
  Application.ScreenUpdating = False
 
'This bit sorts first column
With Sheets("Race sheet")
    .Range("a7:k" & Rows.Count).Sort Key1:=.Range("a7"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'This bit deletes all blank rows after sorting
LR = Range("A" & Rows.Count).End(xlUp).Row
If LR > 20 Then 'doesnt delete less than 20 rows
Range("a7:a" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Else
End If

'This bit adds blank rows after grade/scratch change to group by grades or scratch
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 8 Step -1
    
    If Range("A" & i).Value > Range("A" & i - 1).Value Then Rows(i).Insert
    Range("a" & i).EntireRow.Blank
    'this is where I want to shade the newly inserted row
   Next i
    
EndNow:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
    
End Sub

Can anyone assist ?

 

[onlyadrafter]

Hello,

have updated your code, is it working as expected?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim r As Range
Dim LR As Long, i As Long

  Set r = Intersect(Target, Range("a7:a" & Rows.Count))
  If r Is Nothing Or Target.Count > 1 Then Exit Sub
  
  On Error GoTo EndNow
  Application.EnableEvents = False
  Application.ScreenUpdating = False
 
'This bit sorts first column
With Sheets("Race sheet")
    .Range("a7:k" & Rows.Count).Sort Key1:=.Range("a7"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'This bit deletes all blank rows after sorting
LR = Range("A" & Rows.Count).End(xlUp).Row
If LR > 20 Then 'doesnt delete less than 20 rows
Range("a7:a" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Else
End If

'This bit adds blank rows after grade/scratch change to group by grades or scratch
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 8 Step -1
    
    If Range("A" & i).Value > Range("A" & i - 1).Value Then
        Rows(i).Insert
        Range("a" & i).EntireRow.ClearContents
    'this is where I want to shade the newly inserted row
    Rows(i).Interior.ColorIndex = 16
    End If
   Next i
    
EndNow:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
    
End Sub

change the colorindex 16 to suit.