Removing the Contents from the Cell of a Word Table using Excel VBA

Question

I am currently working on a project and am looking for some assistance. To give you guys a layout of what is happening, I will run through the scenario step by step.

1) Currently I have a string array called “AnimalNamesToRemove” (For this example the array with contain the following words), that contains words that are used as bookmarks in a word document that I am looking to remove off a word table referenced below:

AnimalNamesToRemove

AnimalCat, AnimalDog, AnimalBird

2) In addition to the array, a table in a word document exists that has the name of the animal in column one, as well as some information about the animal (the only information that is of importance is the name of the animal):

Word Table

3) For this scenario, I have an excel table that I am looking to use to reference the words in the array and the word table names, as there are already bookmarks in the word document being used that hold the names existing in the array. To bring these together, a two column excel spreadsheet exists that has the name of the bookmark and the actual animal name (Column two is referenced using the range named “myRangeRef”):

Spreadsheet

4) What I am looking to do is that for every value in the array stated above, if that value (ex. “AnimalDog”) is found in the spreadsheet table (ie column two “Bookmark Reference”) then offset to the respective cell beside it in the first column (ie “Dog”) and create a new comma delimited string with those values, the same as “AnimalNamesToRemove” (ie Cat, Dog, Bird) and then turn it into a string array named “AnimalsToDelete”. Once the array is created, and all the values have been selected in the first column and made into an array based on the reference in column two, I want to go row by row in the word table and for every value existing in the new array “AnimalsToDelete”, if that value (ie Cat, Dog, and Bird) exists in the word table (found in column one), I want the code to delete the entire row that the name is found in (see result shown below)

Example Result

Dim wdTable As Object
Dim myRangeRef As Range
Dim AnimalNamesToRemove As Variant
Dim AnimalsToDelete As Variant
Dim wdDoc As Object

Set myRangeRef = ThisWorkbook.Sheets("Bookmark References").Range("B1:B6")

Set wdTable = wdDoc.Tables(1)
For i = LBound(AnimalNamesToRemove) To UBound(AnimalNamesToRemove)
    For Each cell In myRangeRef
        If InStr(1, cell.Value, AnimalNamesToRemove(i), vbTextCompare) Then
            aCell = cell.Offset(, -1).Value
            stTemp = stTemp & "," & aCell
        End If
    Next cell
Next i

stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
    AnimalsToDelete = Split(stTemp, ",")
    For i = LBound(AnimalsToDelete) To UBound(AnimalsToDelete)
        For j = wdTable.Rows.Count To 2 Step -1
            If wdTable.cell(j, 1).Range.Text = AnimalsToDelete(i) Then wdTable.Rows(j).Delete
        Next j
    Next i
End If

If you have any solutions and/or suggestions please comment them down below.

NOTE: The first section of code works for creating the string array (ie from "set wdTable =" to "next i"), its the removal of information from the word table that I'm having the issues with. Best,

Jack Henderson

Answer 1

Alright, based on your code I added a Reference to the Microsoft Word 16.0 Object Library in my Excel VBE (Tools - References, check the box) so we have the Word stuff available. Next I wrote the following procedure:

Sub Test()
Dim BookMarksToDelete() As String
Dim ReturnsToDelete() As String
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wdTable As Word.Table
Dim myRangeRef As Range
Dim cel As Range
Dim aCell As String

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Temp\Col1.docx")
Set wdTable = wDoc.Tables(1)

ReDim BookMarksToDelete(0 To 1)
    BookMarksToDelete(0) = "BlahOne"
    BookMarksToDelete(1) = "BlahThree"

Set myRangeRef = Worksheets("Sheet1").Range("B1:B5")

For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
    For Each cel In myRangeRef
        If InStr(1, cel.Value, BookMarksToDelete(i), vbTextCompare) Then
            aCell = cel.Offset(0, -1).Value
            stTemp = stTemp & "," & aCell
        End If
    Next cel
Next i

stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
    ReturnsToDelete = Split(stTemp, ",")
    For i = LBound(ReturnsToDelete) To UBound(ReturnsToDelete)
        For j = wdTable.Rows.Count To 2 Step -1
             If Left(wdTable.cell(j, 1).Range.Text, Len(wdTable.cell(j, 1).Range.Text) - 2) = ReturnsToDelete(i) Then
                wdTable.Rows(j).Delete
            End If
        Next j
    Next i
End If

wDoc.Save
wDoc.Close
wApp.Quit

Set wdTable = Nothing
Set wDoc = Nothing
Set wApp = Nothing
Set myRangeRef = Nothing
End Sub

As you can see, I basically stuck to your exact same structure and it works perfectly.

Your main issue (the rows in the word doc not being deleted or found) is because the text in a Cell in a table in word actually contains 2 extra characters in the very end. One is a "fake new line" and the other one shows up when you hit this paragraph button on the word GUI - It's an "end of cell" marker.

See for example this discussion

EDIT I based myself on the "BlahOne" and "NameOne" example, but yeah, you can edit it for animals, of course...