Setting more parameters with Print area code

K

KimberlyC

Hi
I'm using the following code/s below (i'm sure there's an easier way to do
it..but that's the only way I could get it to work) to set the print area of
worksheets with the name Misc to the last entry in row 7 and the last entry
in columns A thru AA.
It's working great...
However, I would like to have the code set the print area to not be less
than column K.. so I guess if the last entry in row 7 is in d7, then have it
set to K7 and what ever cell in columns A thru AA has the last entry.

For example: If E7 was the last entry in row 7 and C451 was the last entry
in columns A thru AA, then I would like the print area to be A1:K451
Intead of A1:E451..which is how the code below would set it.

Another example.. If Z7 was the last entry in row 7 and S614 was the last
entry in columns A thru AA, then I would like the print area to be A1:S614
This code below works good for this example... becasue the last entry in row
7 is past K7.

Not sure if this is possible... 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 BottomRowMisc As Long
Dim LastColumnMisc As Long
Dim BottomRowA As Long
Dim BottomRowB As Long
Dim BottomRowC As Long
Dim BottomRowD As Long
Dim BottomRowE As Long
Dim BottomRowF As Long
Dim BottomRowG As Long
Dim BottomRowH As Long
Dim BottomRowI As Long
Dim BottomRowJ As Long
Dim BottomRowK As Long
Dim BottomRowL As Long
Dim BottomRowM As Long
Dim BottomRowN As Long
Dim BottomRowO As Long
Dim BottomRowP As Long
Dim BottomRowQ As Long
Dim BottomRowR As Long
Dim BottomRowS As Long
Dim BottomRowT As Long
Dim BottomRowU As Long
Dim BottomRowV As Long
Dim BottomRowW As Long
Dim BottomRowX As Long
Dim BottomRowY As Long
Dim BottomRowZ As Long
Dim BottomRowAA As Long

If objSHeet.FilterMode Then objSHeet.ShowAllData
BottomRowA = objSHeet.Cells(Rows.Count, "A").End(xlUp).Row
BottomRowB = objSHeet.Cells(Rows.Count, "B").End(xlUp).Row
BottomRowC = objSHeet.Cells(Rows.Count, "C").End(xlUp).Row
BottomRowD = objSHeet.Cells(Rows.Count, "D").End(xlUp).Row
BottomRowE = objSHeet.Cells(Rows.Count, "E").End(xlUp).Row
BottomRowF = objSHeet.Cells(Rows.Count, "F").End(xlUp).Row
BottomRowG = objSHeet.Cells(Rows.Count, "G").End(xlUp).Row
BottomRowH = objSHeet.Cells(Rows.Count, "H").End(xlUp).Row
BottomRowI = objSHeet.Cells(Rows.Count, "I").End(xlUp).Row
BottomRowJ = objSHeet.Cells(Rows.Count, "J").End(xlUp).Row
BottomRowK = objSHeet.Cells(Rows.Count, "K").End(xlUp).Row
BottomRowL = objSHeet.Cells(Rows.Count, "L").End(xlUp).Row
BottomRowM = objSHeet.Cells(Rows.Count, "M").End(xlUp).Row
BottomRowN = objSHeet.Cells(Rows.Count, "N").End(xlUp).Row
BottomRowO = objSHeet.Cells(Rows.Count, "O").End(xlUp).Row
BottomRowP = objSHeet.Cells(Rows.Count, "P").End(xlUp).Row
BottomRowQ = objSHeet.Cells(Rows.Count, "Q").End(xlUp).Row
BottomRowR = objSHeet.Cells(Rows.Count, "R").End(xlUp).Row
BottomRowS = objSHeet.Cells(Rows.Count, "S").End(xlUp).Row
BottomRowT = objSHeet.Cells(Rows.Count, "T").End(xlUp).Row
BottomRowU = objSHeet.Cells(Rows.Count, "U").End(xlUp).Row
BottomRowV = objSHeet.Cells(Rows.Count, "V").End(xlUp).Row
BottomRowW = objSHeet.Cells(Rows.Count, "W").End(xlUp).Row
BottomRowX = objSHeet.Cells(Rows.Count, "X").End(xlUp).Row
BottomRowY = objSHeet.Cells(Rows.Count, "Y").End(xlUp).Row
BottomRowZ = objSHeet.Cells(Rows.Count, "Z").End(xlUp).Row
BottomRowAA = objSHeet.Cells(Rows.Count, "AA").End(xlUp).Row
BottomRowMisc = Application.Max(BottomRowA, BottomRowB, BottomRowC,
BottomRowD, BottomRowE _
, BottomRowF, BottomRowG, BottomRowH, BottomRowI, BottomRowJ, BottomRowK _
, BottomRowL, BottomRowM, BottomRowN, BottomRowO, BottomRowP, BottomRowQ _
, BottomRowR, BottomRowS, BottomRowT, BottomRowU, BottomRowV, BottomRowW _
, BottomRowX, BottomRowY, BottomRowZ, BottomRowAA)
LastColumnMisc = objSHeet.Cells.Cells(7,
Columns.Count).End(xlToLeft).Column
Set BottomCornerMisc = objSHeet.Cells(BottomRowMisc, LastColumnMisc)

Exit Function

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


Thanks in advance!!
Kimberly
 
S

STEVE BELL

Try using these
The calculation for rw assumes that column A will always go down to the
bottom of the data.

Dim rw As Long, col As Long

rw = Cells(Rows.Count, "A").End(xlUp).Row
col = Cells(7, Columns.Count).End(xlToLeft).Column
If col > 11 then
col =11
End If

sh.PageSetup.PrintArea = Range(Cells(1,1),Cells(re,col))


or you could use these (but they will identify rows and columns that could
have had something in them and the cell/cells were cleared and the workbook
hasn't been saved)

rw = Cells.SpecialCells(xlLastCell).Row
col = Cells.SpecialCells(xlLastCell).Column
 
J

Jim Thomlinson

Try this code and let me know if that is what you wanted...

Sub test()
MsgBox BottomRow(Sheet1).Address
End Sub

Public Function BottomRow(ByVal sh As Worksheet) As Range
Dim rngReturn As Range
Dim rngStartSpot As Range

Set rngStartSpot =
sh.Range("A1").SpecialCells(xlCellTypeLastCell).Offset(1, 0)
Do While rngStartSpot.Column > 0
Set rngReturn = rngStartSpot.End(xlUp)
If rngReturn.Row > 0 Then Exit Do
Set rngStartSpot = rngStartSpot.Offset(0, -1)
Loop
Set BottomRow = rngReturn
End Function
 
D

Dave Peterson

One more...

Option Explicit
Sub PrintareaMisc2()

'Set Print area on Misc sheets
Dim sh As Worksheet

Dim iCol As Long
Dim LastCol As Long
Dim LastRow As Long
Dim LastRowInCol As Long

For Each sh In ActiveWorkbook.Worksheets
With sh
If InStr(1, .Name, "Misc", vbTextCompare) = 0 Then
'do nothing
Else
LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
Select Case LastCol
Case Is < 6
LastCol = 7
Case Is > 27
LastCol = 27
End Select
LastRow = 1
For iCol = 1 To 27 'A to AA
LastRowInCol = .Cells(.Rows.Count, iCol).End(xlUp).Row
If LastRowInCol > LastRow Then
LastRow = LastRowInCol
End If
Next iCol
If LastRow < 7 Then
LastRow = 7
End If
.PageSetup.PrintArea _
= .Range("A1", .Cells(LastRow, LastCol)).Address
MsgBox .Name & vbLf & .PageSetup.PrintArea
End If
End With
Next 'sh

Set sh = Nothing

End Sub
 
K

KimberlyC

Thank you!!!
I tried this out..but... I could not get it to set the print area
correctly..
 
K

KimberlyC

Thank you!
I tried it out and it does set the print area better than mine.
It seems to stop at column G if the last entry in row 7 is before G7
(entires would be in A7-F7).
It sets the the last entry in the Columns correctly..
Let me know if there is a way to set it to go to column K if the last entry
in row 7 is less than K7..
Thanks so much!!
 
K

KimberlyC

Thanks Steve... I'm not sure how to incorporate this into the code or
function...

If you can help.. I would really appreciate it!!
Thanks
Kimberly
 
K

KimberlyC

I got it!!
I changed this part..and it works great!!!

Select Case LastCol
Case Is < 10
LastCol = 11

KimberlyC said:
Thank you!
I tried it out and it does set the print area better than mine.
It seems to stop at column G if the last entry in row 7 is before G7
(entires would be in A7-F7).
It sets the the last entry in the Columns correctly..
Let me know if there is a way to set it to go to column K if the last entry
in row 7 is less than K7..
Thanks so much!!
Dave Peterson said:
One more...

Option Explicit
Sub PrintareaMisc2()

'Set Print area on Misc sheets
Dim sh As Worksheet

Dim iCol As Long
Dim LastCol As Long
Dim LastRow As Long
Dim LastRowInCol As Long

For Each sh In ActiveWorkbook.Worksheets
With sh
If InStr(1, .Name, "Misc", vbTextCompare) = 0 Then
'do nothing
Else
LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
Select Case LastCol
Case Is < 6
LastCol = 7
Case Is > 27
LastCol = 27
End Select
LastRow = 1
For iCol = 1 To 27 'A to AA
LastRowInCol = .Cells(.Rows.Count, iCol).End(xlUp).Row
If LastRowInCol > LastRow Then
LastRow = LastRowInCol
End If
Next iCol
If LastRow < 7 Then
LastRow = 7
End If
.PageSetup.PrintArea _
= .Range("A1", .Cells(LastRow, LastCol)).Address
MsgBox .Name & vbLf & .PageSetup.PrintArea
End If
End With
Next 'sh

Set sh = Nothing

End Sub
Click to expand...
to
do
Click to expand...
in
Click to expand...
 
D

Dave Peterson

Glad you got it working. (I got confused by row 7 and column 7... Doh!)
I got it!!
I changed this part..and it works great!!!

Select Case LastCol
Case Is < 10
LastCol = 11
Click to expand...
 
S

STEVE BELL

Kimberly,

Appears you got better help from the others. So keep going.

If you are interested in what I sent you - change them to message boxes and
see the results

msgbox Cells(Rows.Count, "A").End(xlUp).Row
msgbox Cells(7, Columns.Count).End(xlToLeft).Column
msgbox Cells.SpecialCells(xlLastCell).Row
msgbox Cells.SpecialCells(xlLastCell).Column
 
S

STEVE BELL

Kimberly,

You're Welcome!

It's a pleasure to be able to help...

--
steveB

Remove "AYN" from email to respond
KimberlyC said:
Thanks again!!! I really appreciate it!
Click to expand...
 

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

Similar Threads

Open four Wbooks, copy four columns from each to Master Wbook 16
Search other sheets for numbers & color them 10
Tried and true copy code lines fail me here 7
A simple if <> nn then Msgbox "No Match" 5
Object variable or with Block variable not set 9
Sum a variable length column 1
Remove Identical words 0
Code copies ONLY last j from sheet 9

Top