K
KimberlyC
Hi,
I am trying to use the code below (with the help of this newsgroup) to set
the print area of all worksheets (in my active workbook) with the name
"Misc" to the last entry in row 7 and the last entry in columns A thru AA.
It's not working as it always tries to set the print area to one
cell...which means it's gong to the "On Error Goto... No Corner" part of the
code when the function part runs.
I'm not sure how to fix it and why it's not working... so any help is
greatly appreciated !!
******************
Sub PrintareaMisc()
'Set Print area on Misc 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, "Misc", vbTextCompare) Then
sh.PageSetup.PrintArea = Range("A1", BottomCornerMisc(sh)).Address
End If
Next 'sh
sh1.Activate
Set sh1 = Nothing
Set sh = Nothing
End Sub
*******************
Function BottomCornerMisc(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 BottomCornerMisc = objSHeet.Cells(1, 1)
End Function
Thanks in advance!!
Kimberly
I am trying to use the code below (with the help of this newsgroup) to set
the print area of all worksheets (in my active workbook) with the name
"Misc" to the last entry in row 7 and the last entry in columns A thru AA.
It's not working as it always tries to set the print area to one
cell...which means it's gong to the "On Error Goto... No Corner" part of the
code when the function part runs.
I'm not sure how to fix it and why it's not working... so any help is
greatly appreciated !!
******************
Sub PrintareaMisc()
'Set Print area on Misc 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, "Misc", vbTextCompare) Then
sh.PageSetup.PrintArea = Range("A1", BottomCornerMisc(sh)).Address
End If
Next 'sh
sh1.Activate
Set sh1 = Nothing
Set sh = Nothing
End Sub
*******************
Function BottomCornerMisc(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 BottomCornerMisc = objSHeet.Cells(1, 1)
End Function
Thanks in advance!!
Kimberly