VBA Save Visible Cells on Active Sheet as PDF - excel

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