+ Reply to Thread
Results 1 to 6 of 6

Help adding print area code to working macro

Hybrid View

  1. #1
    Registered User
    Join Date
    01-26-2016
    Location
    TX
    MS-Off Ver
    Excel 2016
    Posts
    99

    Help adding print area code to working macro

    All,

    I have a working macro that splits out invoice lines to separate tabs and I have formatting set. I am attempting to add code for the print area. I found a working suggestion online but don't know how to incorporate within this macro so that all tabs have this page setup. Can someone assist? Thanks in advance

    Code to Add

    Sub AreaPrint ()
    Dim Sheet1 As Worksheet
    
    Set Sheet1 = ActiveWorkbook.Worksheets(1)
    
    With Sheet1.PageSetup
    .Zoom = False
    .Orientation = xlLandscape
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .PrintTitleRows = “$A$1:$Y$1”
    End With
    
    End Sub

    Current Macro

    Sub Test()
     Dim wRow As Long     ' row counter
    Dim wCol As Integer  ' column counter
    Dim wSheetName As String   ' name of sheet that we will create to move data to
    Dim wDataSheetName As String  ' name of sheet that has new data
       
    Dim wFirstRow As Long   ' used to store first row of move
    Dim wLastInvRow As Long ' used to find last row of current invoice
    Dim wLastRow As Long    ' used to store last row of move
    
    wDataSheetName = ActiveSheet.Name
    Dim myloop
    For myloop = Range("D65536").End(xlUp).Row To 1 Step -1
    If Cells(myloop, 11).Value = 0 Then Rows(myloop).EntireRow.Delete
    Next myloop
    Cells.Select
    Cells.EntireColumn.autofit
    With Selection.Font
    .Name = "Arial Narrow"
         	.Size = 10
             	Rows("1:10000").RowHeight = 15
             	Columns("K:L").Select
             	Selection.Style = "Comma"
    
    wSheetName = Range("A2")
    If wSheetName <> "" Then
    Range("A1").Select
    wLastRow = 2
    Do
             	wLastRow = wLastRow + 1
          	Loop Until Cells(wLastRow, 1) = "" And Cells(wLastRow + 1, 1) = ""
                	ActiveWorkbook.Worksheets(wDataSheetName).Sort.SortFields.Clear
          	ActiveWorkbook.Worksheets(wDataSheetName).Sort.SortFields.Add Key:=Range("A2:A4425"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          	ActiveWorkbook.Worksheets(wDataSheetName).Sort.SortFields.Add Key:=Range("J2:J4425"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
          	With ActiveWorkbook.Worksheets(wDataSheetName).Sort
             	.SetRange Range("A2:Y" & Trim(Str(wLastRow - 1)))
             	.Header = xlYes
             	.MatchCase = False
             	.Orientation = xlTopToBottom
             	.SortMethod = xlPinYin
             	.Apply
          End With
       End If
       Do While Range("A2") <> ""
    If wSheetName = "" Then wSheetName = Range("A2")     ' get new sheet name if not present
          Sheets.Add
    On Error Resume Next
    NameSheet:
    ActiveSheet.Name = wSheetName
          	If Err = 1004 Then ' duplicate sheet name found
    On Error GoTo NameSheet
           	wSheetName = InputBox("Duplicate sheet name found!" & vbCrLf & vbCrLf & _
     	"What name do you want to give it?", "SHEET NAME DUPLICATE", wSheetName & "(1)")
    ActiveSheet.Name = wSheetName
    If Err = 0 Then
    On Error GoTo 0 ' turn off error handling
    End If
    End If
          
    Application.Goto reference:=Sheets(wDataSheetName).Range("A2")
    wFirstRow = 2
    wLastInvRow = 2
    Do
    wLastInvRow = wLastInvRow + 1
    Loop Until Cells(wLastInvRow, 1) <> Cells(wLastInvRow - 1, 1)
    wLastInvRow = wLastinvRow - 1
    
    Range("A1:Y" & Trim(Str(wLastInvRow))).Select
    Selection.Copy Destination:=Sheets(wSheetName).Range("A1")
    Range("A2:Y" & Trim(Str(wLastInvRow))).EntireRow.Delete
    Range("A2").Select
       
    Application.Goto reference:=Sheets(wSheetName).Range("A1")
    Range("A1:Y" & Trim(Str(wLastInvRow))).Select
    Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(11, 12), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Range("A1:A" & Trim(Str(wLastInvRow + 99))).Select
    Selection.Rows.Ungroup
    Selection.Rows.Ungroup
    Range("A:Y").Columns.AutoFit
    Range("A1").Select 'return to top left cell
    Application.Goto reference:=Sheets(wDataSheetName).Range("A2")
    wSheetName = ""      ' clear sheet name for next pass
       Loop
    
    End With
    End Sub

  2. #2
    Forum Moderator davesexcel's Avatar
    Join Date
    02-19-2006
    Location
    Regina
    MS-Off Ver
    MS 365
    Posts
    13,486

    Re: Help adding print area code to working macro

    Normally you can loop through the sheets like this,

        Dim sh As Worksheet
        For Each sh In Sheets
            'do your thing to the sheet
            MsgBox "This is Sheet-" & sh.Name & " I want to do something with this sheet!"
        Next sh
    Run the code by itself to see it work.

  3. #3
    Registered User
    Join Date
    01-26-2016
    Location
    TX
    MS-Off Ver
    Excel 2016
    Posts
    99

    Re: Help adding print area code to working macro

    I'm still having issues including this in my original macro. The code below only works on the active sheet. How can I change it to include all sheets?


    Sub Printset ()
    
    With ActiveSheet.PageSetup
    	.PrintTitleRows = “$1:$1”
    	.Orientation = xlLandscape
    	.Zoom = False
    	.FitToPagesWide = 1
    	.FitToPagesTall = False
    End With
    End Sub

  4. #4
    Forum Guru xladept's Avatar
    Join Date
    04-14-2012
    Location
    Pasadena, California
    MS-Off Ver
    Excel 2003,2010
    Posts
    12,378

    Re: Help adding print area code to working macro

    Try this:

    Sub Printset ():Dim ws As Worksheet
    For each ws in ActiveWorkbook.Worksheets
    With ws.PageSetup
    	.PrintTitleRows = “$1:$1”
    	.Orientation = xlLandscape
    	.Zoom = False
    	.FitToPagesWide = 1
    	.FitToPagesTall = False
    End With
    Next
    End Sub
    If I've helped you, please consider adding to my reputation - just click on the liitle star at the left.

    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~(Pride has no aftertaste.)

    You can't do one thing. XLAdept

    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~aka Orrin

  5. #5
    Registered User
    Join Date
    01-26-2016
    Location
    TX
    MS-Off Ver
    Excel 2016
    Posts
    99

    Re: Help adding print area code to working macro

    xladept - thank you! that worked great and i was able to easily add to my original macro.

  6. #6
    Forum Guru xladept's Avatar
    Join Date
    04-14-2012
    Location
    Pasadena, California
    MS-Off Ver
    Excel 2003,2010
    Posts
    12,378

    Re: Help adding print area code to working macro

    You're welcome and thanks for the rep!

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Private sub code no longer working (print area macro)
    By rikkyshh in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 09-09-2013, 10:43 AM
  2. [SOLVED] Need ‘Set Print Area’ Code for Dynamic Print Range based on Conditions
    By dosbirn in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 07-16-2013, 12:13 PM
  3. [SOLVED] Print array code for a series of pages that will also determine print area required?
    By matrixpom in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 11-04-2012, 11:46 PM
  4. [SOLVED] Set Print Area macro Code
    By romandotcom in forum Excel General
    Replies: 8
    Last Post: 06-21-2012, 12:09 AM
  5. Copy Paste Code not working after adding another area
    By Aeneren in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 05-05-2012, 02:39 AM
  6. macro code to set print area and print
    By DrPips in forum Excel General
    Replies: 0
    Last Post: 09-06-2009, 02:36 AM
  7. Print Area:What would be the code for setting the print area
    By wammer in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 09-02-2005, 02:05 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1