Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Insert row

0 views
Skip to first unread message

Andy Devine

unread,
May 2, 2001, 5:10:18 AM5/2/01
to
hi
i've got entries listed in, say, column A that read

e.g.
A1 - A5 could say "Item1"
A6 - A10 "Item 2"
A11 - A15 "Item 3"
etc..

what i'd like to be able to do is to get a macro to insert a page break
where the entries change (e.g. between rows A5 and A6, A10 and A11 etc

At other times like to get the macro to insert a row

If can help would be appreciated

thanks

Andy (an...@tmpw.co.uk)

Dave

unread,
May 2, 2001, 7:01:14 AM5/2/01
to
Andy,

Here are two procedures for what you want. Change the Const SourceColumn =
"A" bit to look at other columns...

Sub InsertPageBreak()
Const SourceColumn = "A"
Dim lRow As Long

For lRow = ActiveSheet.Columns(SourceColumn).SpecialCells(xlLastCell).Row To
2 Step -1
If ActiveSheet.Range(SourceColumn & CStr(lRow)).Value <> _
ActiveSheet.Range(SourceColumn & CStr(lRow - 1)).Value Then _
ActiveSheet.Rows(lRow).PageBreak = xlPageBreakManual
Next lRow
End Sub

Sub InsertLine()
Const SourceColumn = "A"
Dim lRow As Long

For lRow = ActiveSheet.Columns(SourceColumn).SpecialCells(xlLastCell).Row -
1 To 1 Step -1
If ActiveSheet.Range(SourceColumn & CStr(lRow)).Value <> _
ActiveSheet.Range(SourceColumn & CStr(lRow + 1)).Value Then _
ActiveSheet.Rows(lRow + 1).Insert
Next lRow
End Sub

HTH,
Dave.

Andy Devine <an...@tmpw.co.uk> wrote in message
news:u7mmZeu0AHA.1032@tkmsftngp05...

Jim Rech

unread,
May 2, 2001, 7:25:04 AM5/2/01
to
This is for the page break issue. I don't think I ever used
"ColumnDifferences" before, but it had to be good for something!

Sub InsertPgBreaksAtDifferences()
On Error GoTo EndThis
Do
Selection.ColumnDifferences(ActiveCell).Select
ActiveCell.PageBreak = xlManual
Loop
EndThis:
End Sub


--
Jim Rech
Excel MVP

J.E. McGimpsey

unread,
May 2, 2001, 7:55:58 AM5/2/01
to
Very cool! That goes in my "ObscureMacrosIMayNeedSomeday.xls" file!

In article <eW3nmpv0AHA.2028@tkmsftngp05>, "Jim Rech" <jar...@kpmg.com>
wrote:

> This is for the page break issue. I don't think I ever used
> "ColumnDifferences" before, but it had to be good for something!

--
J.E. McGimpsey
Remove NOSPAM from address to send email.

David McRitchie

unread,
May 2, 2001, 9:36:29 AM5/2/01
to
Hi Andy,
When you insert or delete lines you should start from the bottom
row of those you examine --- from the last cell row upward. For
merely inserting page breaks it wouldn't matter which direction
you went.

Since you titled your post as "Insert Row", I expect you wish
to insert both Page Breaks on change in Column A,
and insert blank rows on change in Column B. To prevent
inserting still more lines when rerunning a check is made to
see if a blank row had already been inserted -- so this can
be rerun without further changes.

Expect you wanted the change to be on the same sheet as
opposed to creating a new sheet, but if you want a new
sheet activate the appropriate lines.

If you don't like the results (and sorting is okay):
Manually Remove All Page Breaks:
Select all cells (Ctrl+A)
Insert menu --> Reset all Page Breaks
Manually Remove Inserted Lines:
Select all Cells (Ctrl+A)
Sort on Column A and B, to place blank lines at bottom
-- note lower left corner whether you have header rows or not
Delete those blank lines, and save
To reestablish the last cell (Ctrl+End).

Sub PageBreakonA_SepB()
'David McRitchie, misc, 2001-05-02
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'--Activate if you want changes only in a copy
'Sheets(ActiveSheet.Name).Copy After:=Sheets(ActiveSheet.Name)
Dim lastrow As Long
Dim lastcell As Range
Dim lastMajor As String
Dim lastSecond As String
Dim blanks As Long
blanks = 0
Dim iRow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastMajor = Cells(lastrow, 1)
lastSecond = Cells(lastrow, 2)
Cells.PageBreak = xlNone
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For iRow = lastrow To 3 Step -1
If Trim(Cells(iRow, 1)) <> "" Then
If Cells(iRow, 1) <> lastMajor Then
Cells(iRow + 1, 1).PageBreak = xlManual
lastMajor = Cells(iRow, 1)
lastSecond = Cells(iRow, 2)
blanks = 0
ElseIf Cells(iRow, 2) <> lastSecond Then
lastSecond = Cells(iRow, 2)
If Cells(iRow + 1, 1) <> "" Then
'don't insert if already had a blank line
Cells(iRow + 1, 1).EntireRow.Insert
End If
End If
End If
Next iRow
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

This posting also available at:
http://www.geocities.com/davemcritchie/excel/pagebrks.htm

HTH, for those not familiar with macros: install/use on formula.htm
David McRitchie, Microsoft MVP - Excel (site changed 2000-04-15)
My Excel Macros: http://www.geocities.com/davemcritchie/excel/excel.htm
Search Page: http://www.geocities.com/davemcritchie/excel/search.htm
Google newsgroup search now covers Mar 29, 1995 to current

"Andy Devine" <an...@tmpw.co.uk> ...

John McTigue

unread,
May 2, 2001, 12:15:52 PM5/2/01
to
Hello Andy,

Macros, pah! What are they good for? Don't these VBA flyboys make you
feel inadequate? No?! Oh, its only me then. :-(

Anyway, FWIW:

1. Sort on Column A.
2. Data | Subtotals...
3. 'At each change in:' <Column A>
'Use funcion:' Count
'Add subtotal to:' <Column A>
[x] 'Replace current subtotals' which will be cleared to give blank
row
[x] 'Page break between groups' if require such
'OK'
4. Time for coffee whilst hourglass says hello and overstays welcome.
5. Zzzz - uh? Oh, yeah - where was I?
6. Data | Filter | AutoFilter on Column A and select custom 'Show rows
where' 'contains' "Count"
7. Select all rows containing subtotals, then Alt+<semicolon> to select
visible cells only.
8. Alt+<semicolon> again just to check - should see message "The
selection already contains only visible cells"
(Usually one would expect to see a moving border around the edges of
selected 'subranges' when using Alt+<semicolon>, but looks like if page
breaks visible then can't see this.)
8. Right click 'Clear Contents' to get blank rows separating unique
item groups.

Regards,
John McTigue

0 new messages