Sub Split_Thirdparty_Letters_pdf()
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    Dim xlRng As Object
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim lngDocNum As Long
    Dim docOld As Document
    Dim docNew As Document
    Dim sText As String
    Dim sText2 As String
    Dim sTotal As String
    Dim sDirectory As String

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
    End If
    On Error GoTo 0

    ' Add path to workbook if necessary
    Set xlWbk = xlApp.Workbooks.Open("C:\Users\User\Desktop\Thirdparty Payments\Thirdparty Remitance.xlsm")
    Set xlWsh = xlWbk.Worksheets("Thirdparty")
    Set docOld = ActiveDocument
    lngStart = 1
    selection.HomeKey Unit:=wdStory
    With selection.Find
        .ClearFormatting
        .Text = "Grand *^12"
        .MatchWildcards = True
        .Wrap = wdFindStop
        Do While .Execute
            selection.Collapse Direction:=wdCollapseEnd
            lngEnd = selection.End
            ' Copy the "section"
            docOld.Range(lngStart, lngEnd - 1).Copy
            'Create a new document to paste text from clipboard.
            Set docNew = Documents.Add
            selection.Paste
            lngDocNum = lngDocNum + 1

            sText = docNew.Frames(8).Range.Text
            sDirectory = "C:\Users\User\Desktop\Thirdparty Payments\Thirdparty Letters"
            
            
            Dim Sctn As Section, Frm As Frame, x As Long, v As Single
            With ActiveDocument
              For Each Sctn In .Sections
                With Sctn.Range
                  v = 0
                  For x = 1 To .Frames.Count
                    With .Frames(x)
                      If .Range.Text = "Grand Total" Then
                        v = .VerticalPosition - 7.25: Exit For
                      End If
                    End With
                  Next
                  For x = 1 To .Frames.Count
                    With .Frames(x)
                     
                      If .VerticalPosition = v Then sTotal = .Range.Text: Exit For
                    End With
                  Next
                End With
              Next
            End With
            
            
            'sTotal = docNew.Frames(21).Range.Text
            Set xlRng = xlWsh.Range("B:B").Find(What:=sText, LookAt:=1, MatchCase:=False)
            
             ''Debug.Print "Third party code was not found''
            sText2 = docNew.Frames(10).Range.Text
            If xlRng Is Nothing Then
            MsgBox "THIRD PARTY CODE :" & sText & "  " & sText2 & ", NOT IN EXCEL SHEDULE"
            End If
                        
            If Not xlRng Is Nothing Then
               xlRng.Offset(0, 5).Value = Val(sTotal)
            End If
            
            '''Convert to PDF'''
            docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
            docNew.Close SaveChanges:=False ''close the new document'''

            ' set new start
            lngStart = lngEnd + 1
        Loop
    End With

    ' Last part
    selection.Collapse Direction:=wdCollapseEnd
    lngEnd = ActiveDocument.Content.End
    ' Copy the "section"
    docOld.Range(lngStart, lngEnd - 1).Copy
    'Create a new document to paste text from clipboard.
    Set docNew = Documents.Add
    selection.Paste
     ' Save the new document
    lngDocNum = lngDocNum + 1

    '''Convert to PDF'''
    sText = docNew.Frames(8).Range.Text
    
    
        With ActiveDocument
        For Each Sctn In .Sections
        With Sctn.Range
          v = 0
          For x = 1 To .Frames.Count
            With .Frames(x)
              If .Range.Text = "Grand Total" Then
                v = .VerticalPosition - 7.25: Exit For
              End If
            End With
          Next
          For x = 1 To .Frames.Count
            With .Frames(x)
              If .VerticalPosition = v Then sTotal = .Range.Text: Exit For
            End With
          Next
        End With
      Next
    End With
    
    'sTotal = docNew.Frames(21).Range.Text
    Set xlRng = xlWsh.Range("B:B").Find(What:=sText, LookAt:=1, MatchCase:=False)
    
    ''Debug.Print "Third party code was not found.",,
    sText2 = docNew.Frames(10).Range.Text
    If xlRng Is Nothing Then
    MsgBox "THIRD PARTY CODE :" & sText & "  " & sText2 & ", NOT IN EXCEL SHEDULE"
    End If
    
    If Not xlRng Is Nothing Then
        xlRng.Offset(0, 5).Value = Val(sTotal)
    End If

    docNew.ExportAsFixedFormat OutputFileName:=sDirectory & Trim(sText) & ".pdf", ExportFormat:=17
    docNew.Close SaveChanges:=False ''close the new document'''

    xlWbk.Close SaveChanges:=True
End Sub