Inserting a blank row with a change in data

1. This assumes you have headings on your data columns
2. This is much easier than it looks :)

• Add the column heading "Dummy" to the next column to the right of your data

• Select your data, including the headings AND the dummy column

• Data.Subtotal

...At each change in: (select your first column heading)

...Use function: Sum

...Add subtotal to: Dummy

...Click: OK

• Select the first column

• Home.Find&Select,Find

...Find what: Total

...Click: Find all

• While the cells are selected...CTRL+A (to select all of the matching cells)

• Press: ESC (to close that dialog)

• Press: Delete (to erase the seleted cells

• Delete the Dummy column

Select your data

• Data.Ungroup...(repeat this until all Group levels are cleared)

Is that something you can work with?

Here is a macro that will do what you want...

Sub InsertRowsAndTotals()

    Dim X As Long, LastRow As Long, UnusedCol As Long, Cell As Range

    Const StartRow As Long = 2

    Const DataCol As String = "A"

    LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row

    UnusedCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, _

                SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1

    Application.ScreenUpdating = False

    For X = LastRow - 1 To StartRow Step -1

      If Cells(X, DataCol).Value <> Cells(X + 1, DataCol).Value Then Cells(X + 1, UnusedCol).EntireRow.Insert

    Next

    Application.ScreenUpdating = True

End Sub

There are two items for you to check. The StartRow constant (the first Const statement) establishes where your data starts... I assumed Row 2 (assuming Row 1 is for headers)... change this if I assumed wrong. The DataCol constant (the second Const statement) establishes which column the data that determines where the inserted row should go... I assumed Column A... change this if I assumed wrong.

Here is a macro that will do what you want...

Sub InsertRowsAndTotals()

    Dim X As Long, LastRow As Long, UnusedCol As Long, Cell As Range

    Const StartRow As Long = 2

    Const DataCol As String = "A"

    LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row

    UnusedCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, _

                SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1

    Application.ScreenUpdating = False

    For X = LastRow - 1 To StartRow Step -1

      If Cells(X, DataCol).Value <> Cells(X + 1, DataCol).Value Then Cells(X + 1, UnusedCol).EntireRow.Insert

    Next

    Application.ScreenUpdating = True

End Sub

There are two items for you to check. The StartRow constant (the first Const statement) establishes where your data starts... I assumed Row 2 (assuming Row 1 is for headers)... change this if I assumed wrong. The DataCol constant (the second Const statement) establishes which column the data that determines where the inserted row should go... I assumed Column A... change this if I assumed wrong.

I must be doing something wrong as cannot get the insert row macro to execute.  My data is as such:

Col A

Apparently because my spreadsheet is so large, neither of these worked real well, but I will keep testing it.  The process was going on 30 minutes, and ultimately I cancelled out of it.  The users utilizing this spreadsheet wouldn't be patient enough to wait, and I guess I wasn't either.  Need something perhaps a bit simpler, speedier.  Nevertheless, I will keep working with it - thank you for your help!!!

Hi, try this code.

I assume that your data are on Sheet1

1.  Press ALT+F11 to open VB Ediror

2.  Right-click on Sheet1 (in the Projects Window)

3. Select View Code.
4. Paste the code below:

Private Sub Worksheet_Change(ByVal Target As Range)

'has been tested

Dim c As Long

c = Cells(Rows.Count, "A").End(xlUp).Row

If Not Intersect(Target, Range("A1:A" & c-1)) Is Nothing Then

If Target.Count > 1 Then Exit Sub

Set Target = ActiveCell

Target.EntireRow.Insert

End If

End Sub

Each time you change the value in column A,

you have that you want.