Solved: Find Last Row With Border

[zoom38]

Can someone help me find the last row that has a border. I can find the last row with data but not the last row that has no data but does have a border.

Thanks
Gary

[geekgirlau]

Sub FindLastBorderRow()
Dim rng As Range
Dim rngEnd As Range
Dim lngRowLast As Long
Dim lngRow As Long
Dim r As Long
Dim intCol As Integer
Dim c As Integer


' find the last cell
Set rng = ActiveSheet.UsedRange
Set rngEnd = Range(Mid(rng.Address, InStr(1, rng.Address, ":") + 1))

intCol = rngEnd.Column
lngRow = rngEnd.Row

' loop backwards through the used range
For r = lngRow To 1 Step -1
For c = intCol To 1 Step -1
' only testing for border at bottom of cell
If Cells(r, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
lngRowLast = r
GoTo FoundEnd
End If
Next c
Next r


ExitHere:
Exit Sub

FoundEnd:
MsgBox "The last row with a border is " & lngRowLast
End Sub

[zoom38]

Thankyou GG, I thought there would've been an easier way, but it works great. Below is what i used it for. Could you perhaps explain why my printsetup sub takes so long to complete. It took at least 1 minute for your sub with my printsetup sub to complete. Seems like forever.



Sub FindLastBorderRow()
Dim rng As Range
Dim rngEnd As Range
Dim lngRowLast As Long
Dim lngRow As Long
Dim r As Long
Dim intCol As Integer
Dim c As Integer
Dim Sheet As Integer

For Sheet = 9 To 36
Sheets(Sheet).Activate

' find the last cell
Set rng = ActiveSheet.UsedRange
Set rngEnd = Range(Mid(rng.Address, InStr(1, rng.Address, ":") + 1))

intCol = rngEnd.Column
lngRow = rngEnd.Row

' loop backwards through the used range
For r = lngRow To 1 Step -1
For c = intCol To 1 Step -1
' only testing for border at bottom of cell
If Cells(r, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
lngRowLast = r
Call PrintSetup(lngRowLast)
End If
Next c
Next r
Next Sheet
End Sub

Sub PrintSetup(lngRowLast)

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.21)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 70
.PaperSize = xlPaperLetter
.PrintArea = "$a$1:$l" & lngRowLast
End With

End Sub


Although the speed isn't really that critical I was just wondering why it takes so long to execute. Maybe my way is the long way.

Thanks
Gary

[mudraker]

Your FindLastBorderRow loops through every cell in the ActiveSheet.UsedRange. It continues to loop even after calling PrintSetup. Also activating a sheet slows the process down.

I have modified your code to:-
Remove code that appeared to be doing nothing.
Merginging some lines of code into 1 line of code
Add code to break out of the for loops after PrintSetup has been called
changes made to PrintSetup macro so the sheet to be setup does not have to be active
Overall you should see a speed increase


Sub FindLastBorderRow()
Dim bPrint As Boolean
Dim lngRow As Long
Dim r As Long
Dim intCol As Integer
Dim c As Integer
Dim Sheet As Integer

For Sheet = 9 To 36
bPrint = False
With Sheets(Sheet)
intCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
lngRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

' loop backwards through the used range
For r = lngRow To 1 Step -1
For c = intCol To 1 Step -1
' only testing for border at bottom of cell
If .Cells(r, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
Call PrintSetup(r, Sheet)
bPrint = True
Exit For
End If
Next c
If bPrint = True Then
Exit For
End If
Next r
End With
Next Sheet
End Sub


Sub PrintSetup(lngRowLast As Long, iSheet As Integer)

With Sheets(iSheet).PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.21)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 70
.PaperSize = xlPaperLetter
.PrintArea = "$a$1:$l" & lngRowLast
End With
End Sub

[mdmackillop]

Hi Mudraker,
Highlight the code and click the VBA button to do the formatting, rather than [Code] tags.
BTW, I noticed that GG had an exit from the loop which was omitted by Zoom.

[zoom38]

Yes MD that was a mistake of mine to eliminate the exit. I have added that back in but the routine still takes over a minute to complete. Mudraker your find routine locates the last cell with data. I am looking for a routine that finds the last row with a bottom border which GG created. I replaced your:

intCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
lngRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row


with GG's code:


Set rng = ActiveSheet.UsedRange
Set rngEnd = Range(Mid(rng.Address, InStr(1, rng.Address, ":") + 1))

intCol = rngEnd.Column
lngRow = rngEnd.Row

which finds the last row with a bottom border. I changed from activating sheets to using your isheet code. Overall I don't see a difference in the length of time it takes for your code versus GG's code to complete. I timed your code a 1:46 and GG's code at 1:47.

Here is GG's code modified for my use:

Sub FindLastBorderRow()

Dim rng As Range
Dim rngEnd As Range
Dim LastBorderRow As Long
Dim lngRow As Long
Dim r As Long
Dim intCol As Integer
Dim c As Integer
Dim Sheet As Integer

For Sheet = 9 To 36
Sheets(Sheet).Activate

' find the last cell
Set rng = ActiveSheet.UsedRange
Set rngEnd = Range(Mid(rng.Address, InStr(1, rng.Address, ":") + 1))

intCol = rngEnd.Column
lngRow = rngEnd.Row

' loop backwards through the used range
For r = lngRow To 1 Step -1
For c = intCol To 1 Step -1
' only testing for border at bottom of cell
If Cells(r, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
LastBorderRow = r
Call PrintSetup(LastBorderRow)
GoTo FoundEnd
End If
Next c
Next r
FoundEnd: Next Sheet
End Sub


Sub PrintSetup(LastBorderRow)
Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.21)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 70
.PaperSize = xlPaperLetter
.PrintArea = "$a$1:$l" & LastBorderRow
End With
End Sub

Here is Mudraker's code modified for my use:

Sub FindLastBorderRow()

Dim bPrint As Boolean
Dim lngRow As Long
Dim r As Long
Dim intCol As Integer
Dim c As Integer
Dim Sheet As Integer

For Sheet = 9 To 36
bPrint = False
With Sheets(Sheet)
Set rng = ActiveSheet.UsedRange
Set rngEnd = Range(Mid(rng.Address, InStr(1, rng.Address, ":") + 1))

intCol = rngEnd.Column
lngRow = rngEnd.Row

' loop backwards through the used range
For r = lngRow To 1 Step -1
For c = intCol To 1 Step -1
' only testing for border at bottom of cell
If .Cells(r, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
Call PrintSetup(r, Sheet)
bPrint = True
Exit For
End If
Next c
If bPrint = True Then
Exit For
End If
Next r
End With
Next Sheet
End Sub

Sub PrintSetup(r, isheet As Integer)
Application.ScreenUpdating = False

With Sheets(isheet).PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.21)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 70
.PaperSize = xlPaperLetter
.PrintArea = "$A$1:$L" & r
End With
End Sub


They both take an extremely long time to execute. I was hoping to slim 30 seconds or so off, but again it not that critical.

Thanks
Gary

[mdmackillop]

A different methodology, timed at 4 - 5 seconds.

Option Explicit
Sub DoSetup()
Dim Rw As Long, Rw1 As Long, Rw2 As Long
Dim i As Long, ws As Worksheet
'Set format to find
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
On Error Resume Next
For i = 9 To 36
Rw1 = 0: Rw2 = 0
Set ws = Sheets(i)
With ws
'Data cells
Rw1 = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
SearchFormat:=True).Row
'Blank cells
Rw2 = .Cells.Find(What:="", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
SearchFormat:=True).Row
End With
'Last formatted cell
Rw = Application.WorksheetFunction.Max(Rw1, Rw2)

PrintSetup ws, Rw
Next
End Sub

Sub PrintSetup(ws As Worksheet, Rw As Long)
With ws.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.21)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 70
.PaperSize = xlPaperLetter
.PrintArea = "$A$1:$L$" & Rw
End With
End Sub

[mudraker]

zoom38

I guess I should not try and solve problems when I should be sleeping

MD
2 other excel sites that I'm a memebr of use the Wrap Code for posting the VBA code In. I will try & remember when on this site to use the VBA button & not the #

[zoom38]

MD I get a "Compile Error: Named Argument Not Found" and it highlights SearchFormat=

I'm working with Excel 2000 and the "SearchFormat" argument is not listed in the help file under Find method. Is that in a newer version or do I need to download an addin?

[mdmackillop]

I guess that SearchFormat is a 2003 addition, which means you're stuck with the loop.:(

[mdmackillop]

2 other excel sites that I'm a memebr of use the Wrap Code for posting the VBA code In. I will try & remember when on this site to use the VBA button & not the #
Hi Mudraker,
I've heard that before. Trust us to be different!

[zoom38]

Thank you.

Gary