Good evening. I'm sure this is child's play for most of you, but I'm trying to simplify a horrible data entry task. I have a wealth of customer data that is not in a consistent format as it is copy/pasted for an html based source (some records are missing entries and thus throws off the number of "lines" each record has when pasted into Excel).

I am trying to get a consistent number of blank lines for each record, as some of my housekeeping formulas are built around spaces, and the best way I THOUGHT to do that would be to insert a line above each red highlighted cell, and then remove a line underneath each yellow highlighted cell. Color coding certain cells was housekeeping for me to find inconsistencies in records.

The first two row deletion loops based on text works fine. The code for inserting a row above the red highlighted cells is not, and I haven't yet tried my hand at deleting rows after a yellow highlight. Thanks in advance for any help.

Here's what I so far:

```
Sub DeleteRows()
Dim rng As Range
Dim pos As Integer
Dim LastRow As Long
Set rng = ActiveSheet.UsedRange
For i = rng.Cells.Count To 1 Step -1
pos = InStr(LCase(rng.Item(i).Value), LCase("Show me"))
If pos > 0 Then
rng.Item(i).EntireRow.Delete
End If
Next i
For i = rng.Cells.Count To 1 Step -1
pos = InStr(LCase(rng.Item(i).Value), LCase("Extra Level"))
If pos > 0 Then
rng.Item(i).EntireRow.Delete
End If
Next i
For i = rng.Cells.Count To 1 Step -1
If Cells.Interior.ColorIndex = 3 Then
Rows(rng.Cells(i, 1).Row).Insert shift:=xlDown
End If
Next i
End Sub
```

Display More