More help with setting print area to last entry in columns A thru AA and last entry in row 7

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
 
G

Guest

I dont see an exit function prior to the NoCorner which means that it will
always go on to this section of code. Try adding this...

Function BottomCornerMisc(ByRef objSHeet As Worksheet) As Range
On Error GoTo NoCorner
Dim BottomRow As Long
Dim LastColumn As Long 'Where is this used?
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

exit function
NoCorner:
Beep
Set BottomCornerMisc = objSHeet.Cells(1, 1)
End Function
 
S

STEVE BELL

Quick and dirty...

lastcell = Cells.SpecialCells(xlLastCell).Address

But be careful, this will pick up any blank cells that have been used...
 
K

KimberlyC

Hi

Thanks for you help

When I tried this.. and I get an error message stating "Method Range of
Object _ Global Failed.. and when I click to debug it.....
it goes to this line of code under Sub PrintareaMics() :

sh.PageSetup.PrintArea = Range("A1", BottomCornerMisc(sh)).Address
 
P

pr

KimberlyC said:
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

Try this
This works for me


Sub PrintareaMisc()
'Set Print area on Misc sheets
Dim lc As Long
Dim sh As Excel.Worksheet
For Each sh In ActiveWorkbook.Worksheets
If InStr(1, sh.Name, "Misc", vbTextCompare) Then
lc = WorksheetFunction.Min(sh.UsedRange.Columns.Count, 27)
sh.PageSetup.PrintArea = sh.Range(sh.Cells(1, 1), sh.Cells(7,
lc)).Address
End If
Next
End Sub

phillip
 

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