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