Inserting row after data change

[Cary]

I have an extensive data table sorted by payee. Each payee has many
records. I would like to insert a blank row after each change of payee.

Yes, I could do it manually but the table is very large. Is there an
easier way to do this?

Thanks.

 

[Bernie Deitrick]

Cary,

You could do it easily, but I would recommend against it. Excel operates much better on a single
block of data. Take a look at filtering (Select the table, and choose Data / Filter... Autofilter),
and use that to easily view the data from one payee.

HTH,
Bernie
MS Excel MVP

 

[Cary]

Thanks for your prompt reply.

As the table I refer to is a throwaway that I use for a one-time audit,
I'd be curious as to what that easier and unrecommended method is.

 

[Bernie Deitrick]

Cary,

The easiest manual method is this:

Sort your data table based on payee. Then copy the payee column, and insert that column again, so
that you have two payee columns. Select the data in the new payee column (not the entire column),
and use Data / Filter... Advanced Filter.... check "Copy to another location" "Unique values
only" and choose the cell at the bottom of the new column's list as the location to copy to. Then
click OK.

Then select your entire data table, with the list of unique values included, and sort on that
column. Then delete that column. The blank rows that were sorted into the data table will remain.

HTH,
Bernie
MS Excel MVP

 

[Cary]

Egads! I thought that perhaps that there was a small chunk of VBA or
macro code floating around that might accomplish this simple task.

Thanks!

 

[Bernie Deitrick]

Cary,

Select the list of payees, including the heading row and all the data (but not extra blanks at the
bottom, and not the entire column) and run the macro below.

HTH,
Bernie
MS Excel MVP

Sub CaryInsertBlanks()
Dim myR As Range

Set myR = Selection

myR.EntireColumn.Copy
myR.EntireColumn.Insert shift:=xlToRight

Set myR = myR.Offset(0, -1)
myR.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=myR.Cells(myR.Cells.Count + 1), _
Unique:=True
myR.Cells(myR.Cells.Count + 1).Delete shift:=xlUp
myR.CurrentRegion.Sort Key1:=myR(1, 1), _
Order1:=xlAscending, _
Header:=xlYes
myR(1, 1).Select
myR.EntireColumn.Delete

End Sub

 

[Dave Peterson]

Not quite a blank row, but you could use data|Subtotal.

It won't insert a blank line, but you could have counts and sums and other stuff

 

[Cary]

Many thanks

 

[KC Rippstein]

I think he just wants something like this?:
Sub InsertRow_At_Change()Dim i As Long With Application
..Calculation = xlManual .ScreenUpdating = False End With 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).Resize(1,
1).EntireRow.Insert Next i With Application .Calculation =
xlAutomatic .ScreenUpdating = True End WithEnd SubOr Dave Peterson
pointed out in another post:Just a suggestion, I wouldn't insert an empty
row between the groups. It can make other things more difficult to do
(charting/sorting/filtering/pivottabling(?)).I'd just increase the rowheight
so that the next group looks double spaced.Option ExplicitSub
InsertRowAtChange()Dim LastRow As LongDim iRow As LongWith ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For iRow = LastRow To
2 Step -1 If .Cells(iRow, "C").Value <> .Cells(iRow - 1,
"C").Value Then _ .Rows(iRow).RowHeight =
..Rows(iRow).RowHeight * 2 End If Next iRow End WithEnd

 

[KC Rippstein]

Whoa, that post got all scwewy. I fixed it below.

Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
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).Resize(1, 1).EntireRow.Insert
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

Or Dave Peterson pointed out in another post:
Just a suggestion, I wouldn't insert an empty row between the groups. It
can make other things more difficult to do
(charting/sorting/filtering/pivottabling(?)). I'd just increase the
rowheight so that the next group looks double spaced.

Option Explicit
Sub InsertSpaceAtChange()
Dim LastRow As Long
Dim iRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For iRow = LastRow To 2 Step -1
If .Cells(iRow, "C").Value <> .Cells(iRow - 1, "C").Value Then _
.Rows(iRow).RowHeight = .Rows(iRow).RowHeight * 2
End If
Next iRow
End With
End Sub

 

[Cary]

Thanks for your efforts. But I'm getting compile errors on both macros
you supplied. (I'm assuming I select the data range first and then run
the appropriate macro? I'm a novice at this)

 

[Dave Peterson]

KC had a couple of typos in each routine.

These both worked ok for me. But they don't rely on what you select before
running the code.

The first routine (that inserts an extra row) looks at the data in column 1
(A). The 1 in references like cells(..., 1), refers to column 1.

The second routine (that doubles a rowheight) looks at the data in column C.
You'll see that with the references like: .Cells(iRow, "C")


Option Explicit
Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
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).Resize(1, 1).EntireRow.Insert
End If
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

Sub InsertSpaceAtChange()
Dim LastRow As Long
Dim iRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For iRow = LastRow To 2 Step -1
If .Cells(iRow, "C").Value <> .Cells(iRow - 1, "C").Value Then
.Rows(iRow).RowHeight = .Rows(iRow).RowHeight * 2
End If
Next iRow
End With
End Sub

 

[KC Rippstein]

Thanks, Dave. Sorry about those typos. I had copied the macros originally,
but that did not transfer correctly to the post, so when I tried to go back
in and fix it, I missed the "<>" and accidentally put underscores after
"Then". Appreciate your expertise.