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)
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...
Sub InsertPgBreaksAtDifferences()
On Error GoTo EndThis
Do
Selection.ColumnDifferences(ActiveCell).Select
ActiveCell.PageBreak = xlManual
Loop
EndThis:
End Sub
--
Jim Rech
Excel MVP
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.
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> ...
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