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?
 
Ejgil HedegaardCommented:
It is the sheet references to where the ranges are.
AFDB-Calculator-13.1.18a.xlsm
0
 
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
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
 
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
 
SarahAuthor Commented:
Ejgil & B Hayden - both worked perfectly.
thanks so much
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.