VBA Save Visible Cells on Active Sheet as PDF

Question

I have a code that works successfully but I would like to expand on it so that it only exports the visible cells. When it runs it saves the PDF as required but the PDF has lots of blank space.

Sub OrderFormHide()

    Worksheets("Order Form").Unprotect "!Product1@"
    
'AutoFit All Columns on Worksheet
ThisWorkbook.Worksheets("Order Form").Cells.EntireRow.AutoFit
Application.ScreenUpdating = False

'Hide rows with no data requirements
Dim c As Range
For Each c In Range("A:A")
    If InStr(1, c, "DELETE") Or InStr(1, c, "DELETE") Then
            c.EntireRow.Hidden = True
        ElseIf InStr(1, c, "") Or InStr(1, c, "") Then
            c.EntireRow.Hidden = False
    End If
    Next
    
    Worksheets("Order Form").Protect "!Product1@"
    

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
strDate = Format(Now(), "ddmmyyyy")
strC = Worksheets("Start Page").Range("$C$10").Value



'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 saving file
strFile = strName & "_" & strC & "_" & strDate & ".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
    
Application.ScreenUpdating = True

End Sub

I have used bits from previous codes I have built but I cannot figure out how I implement this change. Any assistance will be greatly appreciated.

Answer 1

Please, try implementing the next way. It uses a new helper sheet, copy there the discontinuous range (as continuous), export this sheet and delete it after:

Sub testExportVisibleCellsRange()
  Dim sh As Worksheet, shNew As Worksheet, rngVis As Range, strPDF As String
  
  strPDF = ThisWorkbook.path & "\testVisible.pdf"
  Set sh = ActiveSheet 'use here the necessary sheet
  
  Set rngVis = sh.UsedRange.SpecialCells(xlCellTypeVisible)

  Set shNew = Worksheets.Add(After:=sh)
  rngVis.Copy shNew.Range("A1")
  shNew.UsedRange.EntireColumn.AutoFit
  With shNew.PageSetup
      .Orientation = xlPortrait
      .FitToPagesWide = 1
  End With
  shNew.ExportAsFixedFormat Type:=xlTypePDF, fileName:=strPDF
  Application.DisplayAlerts = False
    shNew.Delete
  Application.DisplayAlerts = True
End Sub