A Macro to Insert Rows

Hey guys,

So here's the scenario.

I have a list that looks sort of like this:

EXAMPLE A XXXXXXX EXAMPLE A
EXAMPLE A XXXXXXX EXAMPLE A
EXAMPLE B XXXXXXX EXAMPLE B
EXAMPLE B XXXXXXX EXAMPLE B
EXAMPLE C XXXXXXX EXAMPLE C
EXAMPLE C XXXXXXX EXAMPLE C

The list about 1900 rows long. What I need to do is to find a way to automatically seperate and group each "Example" by name, that is, placing a row inbetween Example A and Example B, B and C so it looks like this:

EXAMPLE A XXXXXXX EXAMPLE A
EXAMPLE A XXXXXXX EXAMPLE A

EXAMPLE B XXXXXXX EXAMPLE B
EXAMPLE B XXXXXXX EXAMPLE B

EXAMPLE C XXXXXXX EXAMPLE C
EXAMPLE C XXXXXXX EXAMPLE C

And I need to do this every month when I run a certain report. Is there a way to have Excel automatically insert the rows for me? I doubt there is an "Insert Row" function, but is there possibly a way to do it in VBA? I've tried using macros, but that doesn't seem to do the trick.

Thanks so much!

Hi

This breaks on the value in column A.

Sub aaa()
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If Cells(i - 1, 1) <> Cells(i, 1) Then
      Cells(i, 1).EntireRow.Insert
    End If
  Next i
End Sub

rylo

Does this do what you want?

Sub TND()
    Dim i As Long
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Cells(i, "A") <> Cells(i - 1, "A") _
            And Cells(i, "A") <> "" _
            And Cells(i - 1, "A") <> "" Then
            Rows(i).Insert
        End If
    Next
End Sub

Thank you so much for that code, it works like a charm! Sorry I didn't provide a better template to work with, but that macro seems to work just fine!

Thanks again!

I have the following script that works fine for a single row insert on column b but would like to make it adjustable to insert anywhere from 2 to 16 rows.

Thanks

Sorry forgot to include sample script.

Sub HTH()
Dim i As Long
Dim mycnt As Long
mycnt = Worksheets("Sheet15").Range(Range("b2"), Range("B65536").End(xlUp)).Rows.Count
For i = mycnt To 1 Step -1
If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
Range(Cells(i, 2).Offset(1, -1), Cells(i, 2).Offset(1, 6)).Insert Shift:=xlDown
End If
Next i

End Sub