Need: VBA code to add a empty row

[steveaust]

I wrote this VBA script to add some colour & text formatting to a pivot table >
The code loops thru column 'C' & examines certain cells in each line of the spreadsheet, adding some formatting as it loops thru to enhance readability (see image below) >

Private Sub Cell_Color_Change()


  For Each cell In Range("C:C")
        If cell.Value <> "" Then
          Range(cell.Address).Offset(0, 0).Interior.colorIndex = 35
          Range(cell.Address).Offset(0, 1).Interior.colorIndex = 35
            
        ElseIf Range(cell.Address).Offset(0, -1).Value <> "" Then
          Range(cell.Address).Offset(0, -1).Interior.colorIndex = 27
          Range(cell.Address).Offset(0, 0).Interior.colorIndex = 27
          Range(cell.Address).Offset(0, 1).Interior.colorIndex = 27
          Range(cell.Address).Offset(0, 1).Font.Bold = True
    
    
        ElseIf ((Range(cell.Address).Offset(0, -2).Value <> "") And (Range(cell.Address).Offset(0, -1).Value = "") And (Range(cell.Address).Offset(0, 0).Value = "")) Then
          Range(cell.Address).Offset(0, -2).Interior.colorIndex = 46
          Range(cell.Address).Offset(0, -1).Interior.colorIndex = 46
          Range(cell.Address).Offset(0, 0).Interior.colorIndex = 46
          Range(cell.Address).Offset(0, 1).Interior.colorIndex = 46
          Range(cell.Address).Offset(0, -2).Font.Bold = True
          Range(cell.Address).Offset(0, -1).Font.Bold = True
          Range(cell.Address).Offset(0, 0).Font.Bold = True
          Range(cell.Address).Offset(0, 1).Font.Bold = True
          Range(cell.Address).Offset(0, -2).Font.Size = 12
          Range(cell.Address).Offset(0, -1).Font.Size = 12
          Range(cell.Address).Offset(0, 0).Font.Size = 12
          Range(cell.Address).Offset(0, 1).Font.Size = 12
          ' [B]add code here to insert a blank row under the current position in Range()      [/B]

        End If
    
        Next cell
End Sub

Question: I want to insert a new empty row under the orange formatted line above, to enhance readability.

 

[mehidy1437]

ActiveCell.Offset(1).EntireRow.Insert Shift:=xlShiftDown

 

[Michael M]

How about this....it saves checking the entire column as well !!

Private Sub Cell_Color_Change()
Dim cell As Range, lr As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row
  For Each cell In Range("C1:C" & lr)
        If cell.Value <> "" Then
          Range(cell.Offset(0, 0), cell.Offset(0, -1)).Interior.ColorIndex = 35
        ElseIf Range(cell.Address).Offset(0, -1).Value <> "" Then
          Range(cell.Offset(0, -1), cell.Offset(0, 1)).Interior.ColorIndex = 27
          Range(cell.Address).Offset(0, 1).Font.Bold = True
        ElseIf ((Range(cell.Address).Offset(0, -2).Value <> "") And (Range(cell.Address).Offset(0, -1).Value = "") And (Range(cell.Address).Offset(0, 0).Value = "")) Then
          With Range(cell.Offset(0, -2), cell.Offset(0, 1))
          .Interior.ColorIndex = 46
          .Font.Bold = True
          .Font.Size = 12
          End With
          cell.Offset(1, 0).EntireRow.Insert
        Range(cell.Offset(1, -2), cell.Offset(1, 1)).Interior.ColorIndex = 0
        End If
        Next cell
End Sub

 

[Michael M]

Little shorter

Private Sub Cell_Color_Change()
Dim cell As Range, lr As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row
  For Each cell In Range("C1:C" & lr)
        If cell.Value <> "" Then
          Range(cell.Offset(0, 0), cell.Offset(0, -1)).Interior.ColorIndex = 35
        ElseIf cell.Offset(0, -1).Value <> "" Then
          Range(cell.Offset(0, -1), cell.Offset(0, 1)).Interior.ColorIndex = 27
          cell.Offset(0, 1).Font.Bold = True
        ElseIf cell.Offset(0, -2).Value <> "" And cell.Offset(0, -1).Value = "" And cell.Offset(0, 0).Value = "" Then
          With Range(cell.Offset(0, -2), cell.Offset(0, 1))
          .Interior.ColorIndex = 46
          .Font.Bold = True
          .Font.Size = 12
          End With
          cell.Offset(1, 0).EntireRow.Insert
        Range(cell.Offset(1, -2), cell.Offset(1, 1)).Interior.ColorIndex = 0
        End If
        Next cell
End Sub