Delete paragraph in Microsoft Word if Excel cell is a specified value

Question

This is my first post here and I'm very, very new to vba.

I have an Excel worksheet that I am using to assist in drafting several Word documents. I would like to program a command in Excel that if a specific cell has a specific value, it will delete a particular paragraph in a Word document. Specifically, I want to do something like the following:

if activesheet.range("I99")="1" then
    'code to delete specific paragraph in Word document

elseif activesheet.range("I99")="2" then
    'code to delete different paragraph in Word document

elseif activesheet.range("I99")="3" then
    'code to delete different paragraph in Word document

end if

The following generic code (which I found on this site) in Word does what I want it to do in Word, but I can't get it to work in Excel:

Sub SomeSub()
    Dim StartWord As String, EndWord As String
    Dim Find1stRange As Range, FindEndRange As Range
    Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Setting up the Ranges
    Set Find1stRange = ActiveDocument.Range
    Set FindEndRange = ActiveDocument.Range
    Set DelRange = ActiveDocument.Range

    'Set your Start and End Find words here to cleanup the script
    StartWord = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
    EndWord = "This message has been scanned for malware by Websense. www.websense.com"

    'Starting the Find First Word
    With Find1stRange.Find
        .Text = StartWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        'Execute the Find
        Do While .Execute
            'If Found then do extra script
            If .Found = True Then
                'Setting the Found range to the DelStartRange
                Set DelStartRange = Find1stRange
                'Having these Selections during testing is benificial to test your script
                DelStartRange.Select

                'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
                FindEndRange.Start = DelStartRange.End
                FindEndRange.End = ActiveDocument.Content.End

                'Having these Selections during testing is benificial to test your script
                FindEndRange.Select

                'Setting the Find to look for the End Word
                With FindEndRange.Find
                    .Text = EndWord
                    .Execute

                    'If Found then do extra script
                    If .Found = True Then
                        'Setting the Found range to the DelEndRange
                        Set DelEndRange = FindEndRange

                        'Having these Selections during testing is benificial to test your script
                        DelEndRange.Select

                    End If
                End With

                'Selecting the delete range
                DelRange.Start = DelStartRange.Start
                DelRange.End = DelEndRange.End
                'Having these Selections during testing is benificial to test your script
                DelRange.Select

                'Remove comment to actually delete
                DelRange.Delete
            End If      'Ending the If Find1stRange .Found = True
        Loop        'Ending the Do While .Execute Loop 
    End With    'Ending the Find1stRange.Find With Statement
End Sub

I want to do it this way so that I can edit my Word document without having to edit the vba code. Any help would be greatly appreciated!

Mark

Answer 1

Set a reference to Word (early binding) (check this article)

Read the code's comments and adjust it to fit your needs

' Set a reference to Word Library
Public Sub DeleteInWord()
        
    ' Set reference to worksheet
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("MySheetName")

    ' Define word document path
    Dim wordDocPath As String
    wordDocPath = "C:\Temp"
    
    ' Define word document name (include extension)
    Dim wordDocName As String
    wordDocName = "test.docx"
    
    ' Define start word to find in word document
    Dim startWord As String
    ' Define end word to find in word document
    Dim endWord As String
    
    ' Select the case when value in range I99 is X
    Select Case sourceSheet.Range("I99").Value
    Case 1
        'code to delete specific paragraph in Word document
        startWord = "StartWordValue1"
        endWord = "EndWordValue1"

    Case 2
        'code to delete different paragraph in Word document
        startWord = "StartWordValue2"
        endWord = "EndWordValue2"
    
    Case 3
        'code to delete different paragraph in Word document
        startWord = "StartWordValue3"
        endWord = "EndWordValue3"
    
    End Select
    
    ' Call delete paragraph procedure
    delParagrInWordByStartEndWord wordDocPath, wordDocName, startWord, endWord

End Sub

Private Sub delParagrInWordByStartEndWord(ByVal wordDocPath As String, ByVal wordDocName As String, ByVal startWord As String, ByVal endWord As String)

    ' Turn off stuff
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    ' Set a reference to word
    Dim wordApp As Word.Application
    Set wordApp = createWordObject(True)
    
    ' Fix document path if missing last \
    If Right(wordDocPath, 1) <> "\" Then wordDocPath = wordDocPath & "\"
    
    ' Build document full path
    Dim wordDocFullPath As String
    wordDocFullPath = wordDocPath & wordDocName
    
    ' Open word document
    Dim wordDoc As Word.Document
    If Not wordFileIsOpen(wordDocFullPath) Then
        Set wordDoc = wordApp.Documents.Open(wordDocFullPath)
    Else
        Set wordDoc = wordApp.Documents(wordDocName)
    End If

    'Setting up the Ranges
    Dim find1stRange As Word.Range
    Set find1stRange = wordDoc.Range
    
    Dim findEndRange As Word.Range
    Set findEndRange = wordDoc.Range
    
    Dim delRange As Word.Range
    Set delRange = wordDoc.Range

    'Starting the Find First Word
    With find1stRange.find
        .Text = startWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        'Execute the Find
        Do While .Execute
            'If Found then do extra script
            If .Found = True Then
                'Setting the Found range to the DelStartRange
                Dim delStartRange As Word.Range
                Set delStartRange = find1stRange
                'Having these Selections during testing is benificial to test your script
                delStartRange.Select

                'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
                findEndRange.Start = delStartRange.End
                findEndRange.End = wordDoc.Content.End

                'Having these Selections during testing is benificial to test your script
                findEndRange.Select

                'Setting the Find to look for the End Word
                With findEndRange.find
                    .Text = endWord
                    .Execute

                    'If Found then do extra script
                    If .Found = True Then
                        'Setting the Found range to the DelEndRange
                        Dim delEndRange As Word.Range
                        Set delEndRange = findEndRange

                        'Having these Selections during testing is benificial to test your script
                        delEndRange.Select

                    End If
                End With

                'Selecting the delete range
                delRange.Start = delStartRange.Start
                delRange.End = delEndRange.End
                'Having these Selections during testing is benificial to test your script
                delRange.Select

                'Remove comment to actually delete
                delRange.Delete
            End If      'Ending the If Find1stRange .Found = True
        Loop        'Ending the Do While .Execute Loop
    End With    'Ending the Find1stRange.Find With Statement
End Sub

' Credits: https://stackoverflow.com/a/47162311/1521579
Private Function createWordObject(Optional bVisible As Boolean = True) As Object
    
    Dim tempWordObject As Object

    On Error Resume Next
    Set tempWordObject = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo CleanFail
        Set tempWordObject = CreateObject("Word.Application")
    End If

    tempWordObject.Visible = bVisible
    Set createWordObject = tempWordObject

    On Error GoTo 0
    Exit Function

CleanFail:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateWord."
            Err.Clear
    End Select

End Function

' Credits: https://stackoverflow.com/a/54040283/1521579
Private Function wordFileIsOpen(wordDocFullPath As String) As Boolean

    Dim ff As Long

    On Error Resume Next

    ff = FreeFile()
    Open wordDocFullPath For Input Lock Read As #ff
    Close ff
    wordFileIsOpen = (Err.Number <> 0)

    On Error GoTo 0

End Function