Help with code setting print area

K

KimberlyC

Hi
I am using the following formula (with the helpof this group) to set the
print area of all worksheets with the name "Details" in the worksheet name
(there can be numerous sheets with Details in the name for ex:.. Details
(2), Details (3)) in my activeworkbook
This code sets the area to the last entry in row 7 and the last entry in col
A.
It works great.. however.. I need to ajust it to look at the last entry in
row 7 ...and the last entry in column H OR column I .....depending on
whichever one had the last entry.
So.. if the last entry in row 7 is in P7
and the last entry in column H is H90
and the last entry in I is I89, then the print area would need to be set to
A1:p90.

I'm not sure if this is possible...


Sub PrintareaDetails()
'Set Print area on Details sheets

Dim sh1 As Excel.Worksheet
Dim sh As Excel.Worksheet
Set sh1 = ActiveWorkbook.ActiveSheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
If InStr(1, sh.Name, "Details", vbTextCompare) Then
sh.PageSetup.PrintArea = Range("A1", BottomCorner(sh)).Address
End If
Next sh

sh1.Activate
Set sh1 = Nothing
Set sh = Nothing

End Sub
*******************************
Function BottomCorner(ByRef objSheet As Worksheet) As Range
On Error GoTo NoCorner
Dim BottomRow As Long
Dim LastColumn As Long

If objSheet.FilterMode Then objSheet.ShowAllData

BottomRow = objSheet.Cells(Rows.Count, 1).End(xlUp).Row

LastColumn = objSheet.Cells.Cells(7, Columns.Count).End(xlToLeft).Column
Set BottomCorner = objSheet.Cells(BottomRow, LastColumn)

Exit Function

NoCorner:
Beep
Set BottomCorner = objSheet.Cells(1, 1)
End Function



Thanks in advance!!!
Kimberly
 
T

Tom Ogilvy

*******************************
Function BottomCorner(ByRef objSheet As Worksheet) As Range
On Error GoTo NoCorner
Dim BottomRow As Long
Dim LastColumn As Long
Dim BottomRowH as Long
Dim BottomRowI as Long

If objSheet.FilterMode Then objSheet.ShowAllData

BottomRowH = objSheet.Cells(Rows.Count, "H").End(xlUp).Row
BottomRowI = objSheet.Cells(Rows.Count,"I").End(xlup).Row
BottomRow = Application.Max(BottomRowH, BottomRowI)
LastColumn = objSheet.Cells.Cells(7, Columns.Count).End(xlToLeft).Column
Set BottomCorner = objSheet.Cells(BottomRow, LastColumn)

Exit Function

NoCorner:
Beep
Set BottomCorner = objSheet.Cells(1, 1)
End Function
 
K

KimberlyC

Thanks! It works great..

Is there a way to revise this code to make it look at the last entry in
columns A through Z (instead of just H and I)
and the last entry in row 7 and set the print area based on that?

Thanks for your help!
Kimberly
 
K

KimberlyC

Hi Tom,
I tried the code that you posted ..(can't find the post here..only thru
google) ...and here's what I have now:

Sub PrintareaMisc()
Dim sh1 As Excel.Worksheet
Dim sh As Excel.Worksheet
Set sh1 = ActiveWorkbook.ActiveSheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
If InStr(1, sh.Name, "Misc", vbTextCompare) Then
sh.PageSetup.PrintArea = Range("A1", BottomCorner(sh)).Address

End If
Next 'sh

sh1.Activate
Set sh1 = Nothing
Set sh = Nothing
End Sub

******************************
Function BottomCorner(ByRef objSHeet As Worksheet) As Range
On Error GoTo NoCorner
Dim BottomRow As Long
Dim LastColumn As Long
Dim br As Long
Dim i As Long
If objSHeet.FilterMode Then objSHeet.ShowAllData

BottomRow = 1
For i = 1 To 26
br = objSHeet.Cells(Rows.Count, i).End(xlUp).Row
If br > BottomRow Then BottomRow = br
Next

NoCorner:
Beep
Set BottomCorner = objSHeet.Cells(1, 1)
End Function


When I run it.. I get a message stating the "You've selected a single cell
for the print area"... if this is correct.. click ok.. if not the click
cancel.

Did I do something worng in the code above..as it's not working for me...
Thanks in advance!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top