Solved: LastRow on every page

[tqm1]

Referece: http://www.excelforum.com/showthread.php?t=602958

Dear Sir,

How to findout LastRow on every page in sheet.

Actually I want to apply following border to lastrow of every sheet page


With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


Please help

[JimmyTheHand]

Hi tqm1,

Neither here, nor at the other site, you haven't specified what you mean by LastRow. It's difficult to guess.
Also, you've got some good answers over at the reference link. What is your problem, then?

Jimmy

[tqm1]

This is simple question

I want to locate the Ending Row of every page on sheets("Sheet1")

In my sheet1 ending row are as

Page1-------ending rownumer=55
Page2-------ending rownumer=167
Page3-------ending rownumer=223

and so on.

With VBA codes I want to locte above rows and apply border format.

(Last row on every page must get border as page line)

Thanks

[JimmyTheHand]

We need to clarify some terms.

The excel file, the one with .xls extension, is called Workbook.
Each workbooks contain one or more pages, called Sheets. They are, by default, named as "Sheet1", "Sheet2", "Sheet3", etc.

So, what do you mean by
every page on sheets("Sheet1")?

Here's a piece of code that does what I think you want. But I'm not sure if it is really what you want. (The code works by itself, no parameters or additions are required.)

Sub BottomLine()
Dim ws As Worksheet, LastCell As Range, LastRow As Long

For Each ws In ThisWorkbook.Sheets
Set LastCell = ws.Cells.Find("*", Cells(1,1), xlValues, xlPart, xlByRows, xlPrevious)
If Not LastCell Is Nothing Then
LastRow = LastCell.Row
Else
LastRow = 1
End If

With ws.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
End Sub
HTH,
JImmy

[tqm1]

Dear Sir,

I could not still explain my problem so I try again.

Every page means: when we press Print Preview then we see preview of pages in active sheet.

When I press Print preview button then the last row on page1 is 56.

I have attached Workbook to clear the object.

Please help

[Aussiebear]

Hi TQM1, HOw many lines are on each print page? Is this consistant?

[tqm1]

Hi TQM1, HOw many lines are on each print page? Is this consistant?

Dear Sir,

By viewing Print Preview, you can check Lines on per page.
Or use my attached Excel File.

The rows on per page may differ due to font size.
The VBA codes must automatically detect number of pages and then draw border to the last row of every page.

[tqm1]

Wile web searching I found following link

http://www.mrexcel.com/archive/VBA/19134.html

but still could not get the answer of my problem.

Please help

[geekgirlau]

Sub BottomLine()
Dim ws As Worksheet
Dim pb As HPageBreak
Dim LastRow As Long


For Each ws In ThisWorkbook.Worksheets
ActiveWindow.View = xlPageBreakPreview

For Each pb In ws.HPageBreaks
LastRow = pb.Location.Offset(-1, 0).Row

With ws.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next pb
Next ws
End Sub


This doesn't deal with the issue of page breaks changing as you insert, move, format or delete rows - did you want the routine to remove all bottom margins first?

[johnske]

The only way I know to do this is if you have inserted your own page breaks (either manually {insert menu > Page Break} or by VBA). You can then use something like this.

Option Explicit

Sub PageBreakLines()
Dim PgBreak As HPageBreak
For Each PgBreak In Sheet1.HPageBreaks
If PgBreak.Type = xlPageBreakManual Then
With PgBreak.Location.EntireRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next
End Sub

[johnske]

Same post time! - there musta only been seconds in it GG :rofl:

[JimmyTheHand]

Hi

Here's a piece of code that I wrote. I tested it with different rowheigths and margins and it worked for me, though I'm not sure this is the best solution. The constant highlighted in red is an experimental value, and is valid for A4 pagesize only.

Sub Test()
Dim WS As Worksheet, SumHeight As Double, LastRow As Long, i As Long, BaseRow As Long
Dim NewPage As Boolean

Set WS = ActiveSheet
LastRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Rows
NewPage = True

For i = 1 To LastRow
If NewPage Then
BaseRow = i
NewPage = False
End If
SumHeight = WS.PageSetup.TopMargin + WS.PageSetup.BottomMargin + WS.Range(BaseRow & ":" & i).Height
If SumHeight >= 841.8898 Then
NewPage = True
With WS.Rows(i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next
With WS.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Jimmy

EDIT
Looks like I've been beaten by superiors :)

[geekgirlau]

... and it's GG by a nose :giggles:

By the way John, this will work as long as you're in Page Break Preview mode; you don't need to have any page breaks inserted in the sheet. However it fails in Normal mode - maybe Excel doesn't calculate where the page breaks are until you ask for it.

[tqm1]

Sub BottomLine()
Dim ws As Worksheet
Dim pb As HPageBreak
Dim LastRow As Long


For Each ws In ThisWorkbook.Worksheets
ActiveWindow.View = xlPageBreakPreview

For Each pb In ws.HPageBreaks
LastRow = pb.Location.Offset(-1, 0).Row

With ws.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next pb
Next ws
End Sub


This doesn't deal with the issue of page breaks changing as you insert, move, format or delete rows - did you want the routine to remove all bottom margins first?


These codes work fine according to my need. Thank you very much