2

I'm trying to solve a situation where I have a range of text that can vary considerably depending on the results returned by an array formula. Sometimes there may be 5 rows of data, other times there may be 2000.

I think I've found the chunks of individual VBA codes required for each stage of the task I want to complete, but I am a complete novice with VBA and I have no idea how to piece these together.

The following selects all the actual data on the page, and excludes any rows that contain a hidden formula:

Sub PickedActualUsedRange()
  Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select

End Sub

So far so good. This is the exact range I want to print.

I also want the row height to be adjusted automatically, as each cell may contain a string of text of varying lengths that may be wrapped. So again the following command needs to go in:

Selection.Rows.AutoFit

Not too much trouble so far.

However, for the next bit I would like the VBA to use the selection made above, and to set this as the new print range. However, the code I have found seems to require me to set an absolute range (as per below), whereas I need this to adjust in accordance to the first selection

Selection.PageSetup.PrintArea = "$A$1:$B$12"

Once this is in place, the next step I would like to incorporate is this code I found via from the contextures website for printing the current worksheet:

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Is anybody able to help me incorporate all of the above in to a single string of code please?

FURTHER EDIT

Still not sure what I'm doing with different chunks of code. What would be the exact text I would need to enter in Module1? I don't understand how to structure it:

'Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws As Worksheet) As Range
 Set PickedActualUsedRange = ws.Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function

Sub PDFSheet(wsA As Worksheet) '<-- the sheet in question will be given as parameter
    ' Drop or change the following lines...

    ' Dim wsA As Worksheet '<-- drop
    ' Dim wbA As Workbook  '<-- drop
    ...
    strPath = wsA.Parent.Path ' <-- change
    ...
End Sub

Sub mySyb()
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
End Sub

Sub mySyb()
Dim ws As Worksheet: Set ws = Worksheets("report")
Dim r As Range: Set r = PickedActualUsedRange(ws)
r.Rows.AutoFit
ws.PageSetup.PrintArea = r.Address
PDFSheet (ws)
End Sub
user1883984
  • 87
  • 1
  • 10
  • Do you just want to print the current worksheet? The code (the contextures one) does other things too, like replacing the spaces and periods. I'm not quite clear on what you need to do. Also, read through [how to avoid using `.Select`/`.Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros), which may help answer part of the question. – BruceWayne Jan 28 '17 at 23:36

1 Answers1

0

To fit it the easiest way with your current code, here's how you would setup the print area:

ActiveSheet.PageSetup.PrintArea = Selection.address

And you can call your routines in order

PickedActualUsedRange
Selection.Rows.AutoFit
ActiveSheet.PageSetup.PrintArea = Selection.address
PDFActiveSheet

On a final note, your code uses unqualified ranges and counts a lot on Select, Selection, ActivateSheet etc... which is usually considered bad practice (code will be difficult to maintain). You'd better change it to get rid of these and use explicit sheet names and qualified ranges.

EDIT

' Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws as Worksheet) as Range
 Set PickedActualUsedRange = ws.Range("A1").Resize(ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function

Sub PDFSheet(wsA As Worksheet)
    'www.contextures.com
    'for Excel 2010 and later
    Dim strTime As String, strName As String, strPath As String, strFile As String, strPathFile As String
    Dim myFile As Variant
    On Error GoTo errHandler

    strTime = Format(Now(), "yyyymmdd\_hhmm")

    'get active workbook folder, if saved
    strPath = wsA.Parent.Path & "\"

    'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")

    'create default name for savng file
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = strPath & strFile

    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Select Folder and FileName to save")

    'export to PDF if a folder was selected
    If myFile <> "False" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        'confirmation message with file info
        MsgBox "PDF file has been created: " _
          & vbCrLf _
          & myFile
    End If

exitHandler:
        Exit Sub
errHandler:
        MsgBox "Could not create PDF file"
        Resume exitHandler
End Sub

Sub myMacro
    Dim ws as worksheet: Set ws = Worksheets("report")
    Dim r as range: Set r = PickedActualUsedRange(ws)
    r.Rows.AutoFit
    ws.PageSetup.PrintArea = r.address
    PDFSheet ws
End Sub

Put all this in a code module (i.e. Module1) and call the myMacro through ALT + F8

A.S.H
  • 29,101
  • 5
  • 23
  • 50
  • That's great, thanks. So if the sheet I want to apply this to is called "report", is the solution to start the vba with 'Dim ws As Worksheet Set ws = Worksheets("report")' ? – user1883984 Jan 28 '17 at 23:48
  • Now that I know the sheet's name I will add to my answer an indication to how drop those `select` stuff. – A.S.H Jan 28 '17 at 23:49
  • Thanks so much for this. Apologies for the naive question, but I don't quite understand how to chain all of the code together as one script. How should I structure this from start to finish in the console? – user1883984 Jan 29 '17 at 00:19
  • You can put all this code in `Module1`. The last part can be the body of a macro (`sub mySub` ... `End sub`, also in Module1). Then you can call this macro with `ALT + F8`. – A.S.H Jan 29 '17 at 00:26
  • Sorry I've got to be pushing you patience by now...I'm a total novice at this. I can't get my head around how the final exact code should look? (I've added a further edit to my original post) – user1883984 Jan 29 '17 at 01:01
  • The full code int the **EDIT** section is what should be pasted into Module1. That supposes that you initial macros were ok, as stated in the OP. Copy/Paste all that code then run the macro `myMacro`. – A.S.H Jan 29 '17 at 01:21
  • It's coming up with an error from the last but one line: "PDFSheet (ws)" - says "can't execute code in break mode" – user1883984 Jan 29 '17 at 01:31