I am using the code below to automatically generate an email and embed one pivot table and two tables. This data comes from three separate Power Queries (one original and two duplicates) with slightly different custom columns. This code works perfectly when adding the pivot and one of the two tables. Later, I realized I needed to add a third table and thought it would be easy to modify this code to include, but for some reason, it’s unable to contain the third table, ‘Defect_Log_Open_2’. I decided to remove the original pivot ‘PivotTable2’ and table ‘Defect_Log_Table’ and try to get the newly added table ‘Defect_Log_Open_2’ image to load into the email by itself. The image of that table appeared briefly, like a flicker, and then disappeared. I am at a loss, and frankly, at my wit’s ends why this is occurring, so I thought a fresh pair of eyes could see something I am missing. Thanks for your input.

Sub EmailPivotTableAndDefectTables_AsTablesAndImagesWithDynamicSizing()
    'Declare Outlook Variables
    Dim oLookApp As Object
    Dim oLookItm As Object
    Dim oLookIns As Object
    
    'Declare Word Variables
    Dim oWrdDoc As Object
    Dim oWrdRng As Object
    
    'Declare Excel Variables
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim defectLogTable As ListObject
    Dim defectLogOpenTable2 As ListObject
    Dim slicerInfo As String
    Dim slicerCache As slicerCache
    Dim totalDefects As Variant
    Dim inProgressCount As Variant
    Dim testCount As Variant
    Dim completeCount As Variant
    Dim inProgressPct As Double
    Dim testPct As Double
    Dim completePct As Double
    Dim summary As String
    Dim cellE4Text As String
    Dim defectLogURL As String
    Dim emailAddresses As String
    Dim emailRange As Range
    Dim cell As Range
    Dim pic As Object
    
    ' Set worksheet and tables for PivotTable and Defect_Log_Table
    Set ws = ThisWorkbook.Sheets("DefectsTracker")
    Set pt = ws.PivotTables("PivotTable2")
    Set defectLogTable = ThisWorkbook.Sheets("DefectsTable").ListObjects("Defect_Log_Table")
    Set defectLogOpenTable2 = ThisWorkbook.Sheets("OpenDefects").ListObjects("Defect_Log_Open_2")
    
    ' Get image dimensions from cells
    Dim pivotWidth As Double
    Dim pivotHeight As Double
    Dim tableWidth As Double
    Dim tableHeight As Double
    Dim openTableWidth As Double
    Dim openTableHeight As Double
    
    ' Get pivot table dimensions from cells U4 (width) and U2 (height) on DefectsTracker
    pivotWidth = ws.Range("U4").Value
    pivotHeight = ws.Range("U2").Value
    
    ' Get defect log table dimensions from cells G1 (width) and E1 (height) on DefectsTable
    tableWidth = ThisWorkbook.Sheets("DefectsTable").Range("G1").Value
    tableHeight = ThisWorkbook.Sheets("DefectsTable").Range("E1").Value
    
    ' Get defect log open table 2 dimensions from cells G1 (width) and I1 (height) on OpenDefects
    openTableWidth = ThisWorkbook.Sheets("OpenDefects").Range("G1").Value
    openTableHeight = ThisWorkbook.Sheets("OpenDefects").Range("I1").Value
    
    ' Safely get data from PivotTable using GetPivotData
    totalDefects = 0
    inProgressCount = 0
    testCount = 0
    completeCount = 0
    On Error Resume Next
    totalDefects = pt.GetPivotData("[Measures].[Sum of Sum Row]").Value
    inProgressCount = pt.GetPivotData("[Measures].[Sum of In Progress]").Value
    testCount = pt.GetPivotData("[Measures].[Sum of Test]").Value
    completeCount = pt.GetPivotData("[Measures].[Sum of Complete]").Value
    On Error GoTo 0

    ' Manually calculate percentages
    If totalDefects > 0 Then
        inProgressPct = (inProgressCount / totalDefects)
        testPct = (testCount / totalDefects)
        completePct = (completeCount / totalDefects)
    End If

    ' Set the Defect Log URL
    defectLogURL = "https://cornerstonebuildingbrands.sharepoint.com/sites/CBBUSWERPMES/Lists/Defect%20Log/All%20%20Open%20Defects.aspx"

    ' Retrieve slicer information using VisibleSlicerItemsList
    slicerInfo = "<p><strong>Applied Filters</strong></p><ul>"
    On Error Resume Next
    For Each slicerCache In ThisWorkbook.SlicerCaches
        If slicerCache.PivotTables(1).Name = "PivotTable2" Then
            slicerInfo = slicerInfo & "<li>" & slicerCache.SlicerCacheLevels(1).Name & ": "

            ' Use VisibleSlicerItemsList to get the visible slicer items
            If slicerCache.VisibleSlicerItemsList.Count > 0 Then
                slicerInfo = slicerInfo & Join(slicerCache.VisibleSlicerItemsList, ", ")
            Else
                slicerInfo = slicerInfo & "All"
            End If

            slicerInfo = slicerInfo & "</li>"
        End If
    Next slicerCache
    On Error GoTo 0
    slicerInfo = slicerInfo & "</ul>"

    ' Get the value from cell E4 of the worksheet
    cellE4Text = ws.Range("E4").Value

    ' Create summary string with HTML formatting, hyperlink, slicers
    summary = "<p><strong>The Total Number of Defects is " & totalDefects & ".</strong></p>" & _
              "<p><strong>" & inProgressCount & " In Progress (" & Format(inProgressPct, "0%") & _
              "), " & testCount & " in Test (" & Format(testPct, "0%") & "), and " & completeCount & _
              " Complete (" & Format(completePct, "0%") & ").</strong></p>" & _
              "<p>Here are some insights:</p>" & _
              "<ul>" & _
              "<li>Most defects are Complete, indicating that the project is progressing well.</li>" & _
              "<li>Some defects are still in the In Progress and Test phases, so continued monitoring is necessary.</li>" & _
              "</ul>" & _
              "<p>To view the complete listing of all defects for Genesis, please click <a href='" & defectLogURL & "'>Genesis Defect Log</a>.</p>" & _
              slicerInfo & _
              "<p><strong>" & cellE4Text & "</strong></p>" & "<br>" & "<br>"

    ' Get email addresses from the "Contacts" sheet
    Set emailRange = ThisWorkbook.Sheets("Contacts").Range("A2:A1000") ' Adjust this range as per your data
    emailAddresses = ""
    For Each cell In emailRange
        If cell.Value <> "" Then
            emailAddresses = emailAddresses & cell.Value & ";"
        End If
    Next cell

    ' Late Binding: Create an instance of Outlook application
    Set oLookApp = CreateObject("Outlook.Application")

    ' Create new email item
    Set oLookItm = oLookApp.CreateItem(0)

    With oLookItm
        ' Set subject and recipients
        .To = emailAddresses
        .Subject = "Genesis Defect Summary Report"
        
        ' Set HTML body with formatted summary and insights
        .HTMLBody = summary

        ' Display the email for review
        .Display
        
        ' Get the Active Inspector and Word Document for content manipulation
        Set oLookIns = .GetInspector
        Set oWrdDoc = oLookIns.WordEditor
        
        ' Insert PivotTable as an image
        pt.TableRange2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set oWrdRng = oWrdDoc.Content
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.Paste ' Paste the PivotTable image
        
        ' Adjust the size of the pivot table image using dynamic values from cells
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Width = pivotWidth
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Height = pivotHeight
        
        ' Insert a paragraph break
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.InsertParagraphAfter
        
        ' Insert Defect Log table as an image (preserving formatting)
        defectLogTable.Range.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.Paste ' Paste the Defect_Log_Table image
        
        ' Adjust the size of the defect log table image using dynamic values from cells
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Width = tableWidth
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Height = tableHeight
        
        ' Insert a paragraph break
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.InsertParagraphAfter
        
        ' Insert Defect Log Open 2 table as an image (preserving formatting)
        defectLogOpenTable2.Range.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.Paste ' Paste the Defect_Log_Open_2 image
        
        ' Adjust the size of the defect log open 2 table image using dynamic values from cells
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Width = openTableWidth
        oWrdDoc.InlineShapes(oWrdDoc.InlineShapes.Count).Height = openTableHeight
        
        ' Insert final paragraph for closing
        oWrdRng.Collapse Direction:=wdCollapseEnd
        oWrdRng.InsertParagraphAfter
        oWrdRng.InsertAfter "Thank you,"
        oWrdRng.InsertParagraphAfter
        oWrdRng.InsertAfter "Project Management Office"
        oWrdRng.InsertParagraphAfter
    End With
End Sub

I reviewed the code to ensure it was formatted correctly to include the third additional table I need embed and I ran debug to ensure there weren’t any compiling issue. This should work and I am at a loss why it doesn’t.