|
Setting more parameters with Print area code
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 |
Setting more parameters with Print area code
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 -- steveB Remove "AYN" from email to respond "KimberlyC" wrote in message ... 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 |
Setting more parameters with Print area code
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).Of fset(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 -- HTH... Jim Thomlinson "KimberlyC" wrote: 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 |
Setting more parameters with Print area code
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 KimberlyC wrote: 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 -- Dave Peterson |
Setting more parameters with Print area code
Thank you!!!
I tried this out..but... I could not get it to set the print area correctly.. "Jim Thomlinson" wrote in message ... 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).Of fset(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 -- HTH... Jim Thomlinson "KimberlyC" wrote: 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 |
Setting more parameters with Print area code
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" wrote in message ... 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 KimberlyC wrote: 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 -- Dave Peterson |
Setting more parameters with Print area code
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 "STEVE BELL" wrote in message news:dDize.11058$kh3.2086@trnddc03... 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 -- steveB Remove "AYN" from email to respond "KimberlyC" wrote in message ... 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 |
Setting more parameters with Print area code
I got it!!
I changed this part..and it works great!!! Select Case LastCol Case Is < 10 LastCol = 11 "KimberlyC" wrote in message ... 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" wrote in message ... 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 KimberlyC wrote: 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 -- Dave Peterson |
Setting more parameters with Print area code
Glad you got it working. (I got confused by row 7 and column 7... Doh!)
KimberlyC wrote: I got it!! I changed this part..and it works great!!! Select Case LastCol Case Is < 10 LastCol = 11 "KimberlyC" wrote in message ... 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" wrote in message ... 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 KimberlyC wrote: 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 -- Dave Peterson -- Dave Peterson |
Setting more parameters with Print area code
Thanks again!!! I really appreciate it!
"Dave Peterson" wrote in message ... Glad you got it working. (I got confused by row 7 and column 7... Doh!) KimberlyC wrote: I got it!! I changed this part..and it works great!!! Select Case LastCol Case Is < 10 LastCol = 11 "KimberlyC" wrote in message ... 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" wrote in message ... 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 KimberlyC wrote: 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 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 -- Dave Peterson -- Dave Peterson |
Setting more parameters with Print area code
Kimberly,
You're Welcome! It's a pleasure to be able to help... -- steveB Remove "AYN" from email to respond "KimberlyC" wrote in message ... Thanks again!!! I really appreciate it! "Dave Peterson" wrote in message ... Glad you got it working. (I got confused by row 7 and column 7... Doh!) KimberlyC wrote: I got it!! I changed this part..and it works great!!! Select Case LastCol Case Is < 10 LastCol = 11 "KimberlyC" wrote in message ... 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" wrote in message ... 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 KimberlyC wrote: 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 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 -- Dave Peterson -- Dave Peterson |
| All times are GMT +1. The time now is 10:29 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com