VBA not taking column widths, borders, and conditional formatting from source WS to pdf

[juscuz419]

I have been working on this for two days and cannot get the formatting details to come through on the pdf being attached to an email. All of the data is there but it is useless without the formatting

Option Explicit

Sub CreateAndEmailPDF()
Dim wsSource As Worksheet, wsTemp As Worksheet
Dim selectedCells As Range, cell As Range
Dim tempRow As Long
Dim outlookApp As Object, outlookMail As Object
Dim emailAddresses As String
Dim pdfFilePath As String

' Set the source worksheet
Set wsSource = Worksheets("Training View")

' Prompt user to select cells in Column A
On Error Resume Next
Set selectedCells = Application.InputBox("Select cells in Column A", Type:=8)
On Error GoTo 0

If selectedCells Is Nothing Then Exit Sub ' Exit if no cells selected

' Add a temporary worksheet
Set wsTemp = Worksheets.Add
wsTemp.Name = "Training Data"

' Copy headers from H5:S5, skipping hidden columns (Q and R)
wsSource.Range("H5:P5").Copy
wsTemp.Range("C1").PasteSpecial Paste:=xlPasteAll
wsSource.Range("S5").Copy
wsTemp.Range("L1").PasteSpecial Paste:=xlPasteAll

' Retain column widths
Dim col As Long
For col = 8 To 17
If wsSource.Columns(col).Hidden = False Then
wsTemp.Columns(col - 7).ColumnWidth = wsSource.Columns(col).ColumnWidth
End If
Next col

' Set the initial row for data in the temp sheet
tempRow = 2

emailAddresses = ""
For Each cell In selectedCells
If cell.Column = 1 Then
' Collect email addresses from Column G
If emailAddresses = "" Then
emailAddresses = wsSource.Cells(cell.Row, 7).Value
Else
emailAddresses = emailAddresses & ";" & wsSource.Cells(cell.Row, 7).Value
End If

' Copy values and formatting from selected rows, ignoring hidden columns
wsTemp.Cells(tempRow, 1).Value = wsSource.Cells(cell.Row, 3).Value ' Column C
wsTemp.Cells(tempRow, 2).Value = wsSource.Cells(cell.Row, 1).Value ' Column A

wsSource.Range("H" & cell.Row & ":P" & cell.Row).Copy
wsTemp.Cells(tempRow, 3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsSource.Range("S" & cell.Row).Copy
wsTemp.Cells(tempRow, 12).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

tempRow = tempRow + 1
End If
Next cell

' Define the file path for the PDF
pdfFilePath = ThisWorkbook.Path & "\Training_Data.pdf"

' Fit sheet to one page width in landscape mode
With wsTemp.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

' Export the temp sheet as a PDF
wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

' Set up Outlook and create email
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(0)

With outlookMail
.To = emailAddresses
.Subject = "Training Data PDF"
.Body = "Attached is the Training Data PDF."
.Attachments.Add pdfFilePath
.Display ' Show email for user review
End With

' Delete the temp sheet
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True

' Clean up
Application.CutCopyMode = False
'MsgBox "PDF created and email draft is ready!"
End Sub

 

[6StringJazzer]

This might be difficult to resolve without access to your file.

You are deleting the temporary sheet as soon as you attach the PDF to the email. It is very possible that the sheet is not actually formatted how you think it is. That is, this problem likely has nothing to do with exporting the sheet as a PDF, but rather how the sheet is set up.

First I suggest you comment out the line that deletes the sheet so you can see what it looks like. That will allow you to inspect the formatting, including the conditional formatting, and compare that to your expectations.

wsTemp.Delete

Since we do not know what formatting exists in the source sheet, or what formatting you want in the new sheet, there is no way for us to know what is wrong in the code. Do you have a way to share the file (OneDrive, Google Docs, Dropbox, etc.) so we can try running the code? Can you at a minimum be explicit about the formatting you are expecting to see but don't?

 

[juscuz419]

Some of the data is personal and sensitive. Here is a snippet of the data with the formatting. The pale yellow is generated when the field is blank. The red is generated when the cell is NO based on a formula that checks certain conditions. The top row in Green is the header. Code is not pulling forward the column widths, the borders, or the cell fill conditional formatting that exists in the source WS.

2025 PowerSafe Number	OMA (Eversource)	2025 Safety Manual Training	*PVD Training	*Wire Guard Training	*Basic Contractor Review	2024 PowerSafe Number	SSE Training Complete	Powersafe Training Complete	OMA Training Complete
1070936			2023	2023		1070936	No	Yes
			2024	2024		1397464	No	No
*1095903	OMA-2023-11102		2023	2023		*1095903	No	Yes	No
*1080622			2023	2023		1080622	No	Yes
1123257	OMA-2023-11122		2023	2023		1123257	No	Yes	No
1123331			2023	2023		1123331	No	Yes

 

[juscuz419]

Well that didnt work. Here is a png

 

[juscuz419]

Leaving off the names which would be to the left of each row after the header, the following is what appears on the temp sheet.

 

[Candyman8019]

Perhaps in this section you could use xlPasteAll rather than values and number formats:

wsSource.Range("H" & cell.Row & ":P" & cell.Row).Copy
wsTemp.Cells(tempRow, 3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsSource.Range("S" & cell.Row).Copy
wsTemp.Cells(tempRow, 12).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

 

[6StringJazzer]

NumberFormats is just for number formats.

If you have formulas in these cells and want to paste values only then add a step:

wsSource.Range("H" & cell.Row & ":P" & cell.Row).Copy
wsTemp.Cells(tempRow, 3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsTemp.Cells(tempRow, 3).PasteSpecial Paste:=xlPasteFormats
wsSource.Range("S" & cell.Row).Copy
wsTemp.Cells(tempRow, 12).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsTemp.Cells(tempRow, 12).PasteSpecial Paste:=xlPasteFormats

 

[juscuz419]

That works pulling the data and formatting in but the Header columns are still not preserving the column widths and the formatting for the two name columns (C and A) is not coming through

 

[Candyman8019]

Not sure if this is your case, but I experienced something similar recently. My fix was to copy the sheet to a separate workbook, remove all formatting, then copy the values back to the original workbook as text only. In my case I suspect there was some hidden character that PDF didn't like.

 

[juscuz419]

When I changed the code as suggested by 65StringJazzer, this is what I get. It is close just the column widths and the formatting for column C and A.