Print named ranges based on cell value

Hi, I need to print 5 different named range areas dependent on a cell value

Sheet name 'Navigator', cell B9
If B9 = 1 print 'Arab1'
If B9 = 2 print 'Arab1' & 'Arab2'
If B9 = 3 print 'Arab1' & 'Arab2' & 'Arab3'
If B9 = 4 print 'Arab1' & 'Arab2' & 'Arab3' & 'Arab4'
If B10 = 5 print 'Arab1' & 'Arab2' & 'Arab3' & 'Arab4' & 'Arab5'

I want the print button to appear on Sheet 'Arable Margin'

Hope you have enough information - any help appreciated
thanks
SarahAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ejgil HedegaardCommented:
In attached demo are 5 named ranges Arab1 to Arab5 on sheet Navigator.
The ranges are filled with the values 1 to 5 as the name, to show on the print.
On sheet 'Arable Margin' is a number in B9, and the print button.
If the number is 1 to 5, the ranges are selected as print area.
If the number is something else, nothing happens.

Excel sets a page break between each print  range.

Below code is in Module1.
For test it is set to print preview.
Remove the ' in the front of 'wsNavigator.PrintOut, and set a ' in front of wsNavigator.PrintPreview to make it print.
' means it is a comment doing nothing.

Option Explicit

Sub PrintRanges()
    Dim wsNavigator As Worksheet
    Dim prtRanges As Boolean
    
    Application.ScreenUpdating = False
    
    Set wsNavigator = ThisWorkbook.Worksheets("Navigator")
    prtRanges = True
    Select Case Range("B9")
        Case 1
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
        Case 2
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address
        Case 3
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address
        Case 4
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address
        Case 5
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address & "," & Range("Arab5").Address
        Case Else
            prtRanges = False
    End Select
    If prtRanges Then
        wsNavigator.PrintPreview
        'wsNavigator.PrintOut
    End If
End Sub

Open in new window

Print-ranges.xlsm
0
SarahAuthor Commented:
thanks for the prompt response, however, when I tested it the number of pages to print increased/decreased per the cell reference number e.g. 4 sheets to print when '4' was entered, however, all 4 sheets showed the values of Arab1 e.g. 11111111, 11111111, 11111111, 11111111 rather than 11111111, 22222222222222222222, 333333333333, 444444444444

Hope this makes sense
thanks
Sarah
0
Mike in ITIT System AdministratorCommented:
You could change the code to this:
Option Explicit

Sub PrintRanges()
    Dim wsNavigator As Worksheet
    Dim prtRanges As Boolean
    
    Application.ScreenUpdating = False
    
    Set wsNavigator = ThisWorkbook.Worksheets("Navigator")
    prtRanges = True
    Select Case Range("B9")
        Case 1
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
        Case 2
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab2").Address
            wsNavigator.PrintPreview
        Case 3
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab2").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab3").Address
            wsNavigator.PrintPreview
        Case 4
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab2").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab3").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab4").Address
            wsNavigator.PrintPreview
        Case 5
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab2").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab3").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab4").Address
            wsNavigator.PrintPreview
            wsNavigator.PageSetup.PrintArea = Range("Arab5").Address
            wsNavigator.PrintPreview
        Case Else
            prtRanges = False
    End Select
    If prtRanges Then
        wsNavigator.PrintPreview
        'wsNavigator.PrintOut
    End If
End Sub

Open in new window


Then just update the "PrintPreview" lines to be "PrintOut" lines and it will print each page one at a time. I tested this with the "PrintPreview" and just stepped through the code.
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Ejgil HedegaardCommented:
Strange that it knows there are 4 pages, but only use the first range for all 4.
I made it in Excel 2007, and 4 pages are created with expected values, so guess MS has changed something in later versions.

You could try to create the print area manually by pointing to the ranges, and see what happens.
Then look how it is in the page setup, perhaps it has to be written differently to print non contiguous areas.

I will do that tomorrow at work, where I use Excel 2013.
Printing each range separately will influence page numbering.
If you don't need that, a workaround like Mike did, is what I would do when VBA don't behave as expected.

With PrintOut or PrintPreview in the Case statements, all with the prtRanges variable can be deleted.
Line 5, 10, 47-48 and 50-53 in Mikes code.
0
Mike in ITIT System AdministratorCommented:
I have updated the VBA to copy all the print areas that are requested to another sheet (that is created for that purpose). It then will print the whole sheet with page breaks between the print areas thus allowing you to keep the page numbering from before.

Then it deletes the sheet that was created after printing.

I did notice that the print preview does not reflect this correctly when done in the VBA, but it did print the way it was supposed to.
Sub PrintRanges()
    Dim wsNavigator As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsNavigator = ThisWorkbook.Worksheets("Navigator")
    Dim wsNew As Worksheet
    Dim LastRow
    Dim wsPages As Worksheet
    Select Case ActiveWorkbook.Sheets("Arable Margin").Range("B9")
        Case 1
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
            wsNavigator.PrintPreview
            'wsNavigator.PrintOut
        Case 2
            Set wsNew = Worksheets.Add
            ActiveSheet.Name = "Pages"
            Set wsPages = Sheets("Pages")
            wsNavigator.Range("Arab1").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab2").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            wsPages.PrintPreview
            'wsPages.PrintOut
        Case 3
            Set wsNew = Worksheets.Add
            ActiveSheet.Name = "Pages"
            Set wsPages = Sheets("Pages")
            wsNavigator.Range("Arab1").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab2").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab3").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            wsPages.PrintPreview
            'wsPages.PrintOut
        Case 4
            Set wsNew = Worksheets.Add
            ActiveSheet.Name = "Pages"
            Set wsPages = Sheets("Pages")
            wsNavigator.Range("Arab1").Copy
            wsPages.Paste Destination:=wsPages.Range("A1")
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab2").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab3").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab4").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            wsPages.PrintPreview
            'wsPages.PrintOut
        Case 5
            Set wsNew = Worksheets.Add
            ActiveSheet.Name = "Pages"
            Set wsPages = Sheets("Pages")
            wsNavigator.Range("Arab1").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab2").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab3").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab4").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            LastRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
            wsPages.Rows(LastRow).PageBreak = xlPageBreakManual
            wsNavigator.Range("Arab5").Copy
            wsPages.Paste Destination:=wsPages.Range("A" & LastRow)
            wsPages.PrintPreview
            'wsPages.PrintOut
        Case Else
    End Select
    Application.DisplayAlerts = False
    wsNew.Delete
    Application.DisplayAlerts = True
End Sub

Open in new window

0
Ejgil HedegaardCommented:
A problem with the intermediate sheet is that there can't be different column widths for the ranges.

It is disabling screen updating that cause the problem
When that is removed it works.

Option Explicit

Sub PrintRanges()
    Dim wsNavigator As Worksheet
    Dim prtRanges As Boolean
    
    Set wsNavigator = ThisWorkbook.Worksheets("Navigator")
    prtRanges = True
    Select Case Range("B9")
        Case 1
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address
        Case 2
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address
        Case 3
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address
        Case 4
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address
        Case 5
            wsNavigator.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address & "," & Range("Arab5").Address
        Case Else
            prtRanges = False
    End Select
    If prtRanges Then
        wsNavigator.PrintPreview
        'wsNavigator.PrintOut
    End If
End Sub

Open in new window

Print-ranges.xlsm
0
B HaydenCommented:
Another method:

Sub PrintTheRange()

Dim prntRangeFull As String, prntRangeTrimmed As String
Dim i As Integer
Dim NumAreas As Long

On Error Resume Next

For Each nm In ThisWorkbook.Names

    If nm.Name Like "Arab?" Then
    
        counter = counter + 1
        
    End If
    
Next nm
    
If ((Range("b9") >= 1) And (Range("b9") <= counter)) Then

    For i = 1 To Range("b9").Value

        prntRangeFull = prntRangeFull & Range("Arab" & i).Address & ","
        
    Next i
    

prntRangeTrimmed = Left(prntRangeFull, Len(prntRangeFull) - 1)

ThisWorkbook.Worksheets("Navigator").PageSetup.PrintArea = Range(prntRangeTrimmed).Address
ThisWorkbook.Worksheets("Navigator").PrintPreview

Else

MsgBox ("Error- cannot print!")

End If

End Sub

Open in new window

0
SarahAuthor Commented:
hi. thanks for all the inputs and apologies for the late reply.
Egil - I can see that the file is working as required in your example but it does not translate in my file. I'm going to have a look at my file to see what I've done wrong. thanks
0
Ejgil HedegaardCommented:
If possible you could upload a sample of your file.
0
SarahAuthor Commented:
Hi Egil

I've attached a cut down version of my file but with the 2 relevant sheets included. Appreciate any steer on where I am going wrong here.
thanks
Sarah
AFDB-Calculator-13.1.18a.xlsm
0
B HaydenCommented:
As far as I can see, the sheet references in the macro contained in the uploaded file were mixed up i.e. where 'Navigator' was referred to should have been 'Arable margin' and vice versa  :)  Also, the 'B9' range references needed the specific sheet codename or name to be prepended to the range reference.
The following amended code seems to do what is required:

Sub PrintRanges()
    
    Dim wsNavigator As Worksheet
    Dim prtRanges As Boolean
    
    Set wsNavigator = ThisWorkbook.Worksheets("Navigator")
    prtRanges = True
    
    Select Case wsNavigator.Range("B9")
        Case 1
            Sheet21.PageSetup.PrintArea = Range("Arab1").Address
        Case 2
            Sheet21.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address
        Case 3
            Sheet21.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address
        Case 4
            Sheet21.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address
        Case 5
            Sheet21.PageSetup.PrintArea = Range("Arab1").Address & "," & Range("Arab2").Address _
                & "," & Range("Arab3").Address & "," & Range("Arab4").Address & "," & Range("Arab5").Address
        Case Else
            prtRanges = False
    End Select
    If prtRanges Then
        Sheet21.PrintPreview
        'wsNavigator.PrintOut
    End If
End Sub

Open in new window

0
Ejgil HedegaardCommented:
It is the sheet references to where the ranges are.
AFDB-Calculator-13.1.18a.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
SarahAuthor Commented:
Ejgil & B Hayden - both worked perfectly.
thanks so much
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.