VBA to delete bookmark when Criteria not met in word document

Question

I have a Word document where I have bookmarked lines of text - say 10 lines each. I have 6 of these texts lines on different pages of the word document, so I have a total of 6 bookmarks in the entire Word document. Now given certain criteria in Excel, say if Coulmn A1:A6 have:

0,1,1,1,0,1

Where IF cell A1 is 0 delete first bookmark named sai1, sai1.delete, If cell A2 is 1 dont delete bookmark named sai2 , if cell A3 is 1 dont delete, but if 0 delete and so on and so forth; essentially what i want is a loop to do this for 100+ some bookmarks given 100+ criteria in excel, it might be more. I could not find an easier way beside if-else statement. I will really appreciate the help. here is my code so far:

Set wtb1 = wdd.Bookmarks("D043").Range
Set wtb2 = wdd.Bookmarks("D044").Range
Set wtb3 = wdd.Bookmarks("D018").Range
Set wtb4 = wdd.Bookmarks("D046").Range
If Sheets("CPA").Cells(426, 7).Value = 0 Then
         wtb1.Delete
         ElseIf Sheets("CPA").Cells(427, 7).Value = 0 Then
               wtb2.Delete
         ElseIf Sheets("CPA").Cells(428, 7).Value = 0 Then
               wtb3.Delete
         ElseIf Sheets("CPA").Cells(429, 7).Value = 0 Then
               wtb4.Delete
End If

Is there a For loop method to tackle this? I also tried doing this:

 For k = 426 To 429
 If Sheets("CPA").Cells(k, 7).Value = 0 Then

     'Sheets("CPA").Cells(i, 10) = Sheets("CPA").Cells(i, 9).Value
     Value1 = Sheets("CPA").Cells(426, 9).Value
     Value1(i).Text.Delete
     i = i + 1
     End If
 Next

TheEngineer TheEngineer · Accepted Answer · 2016-01-08T13:59:19

I know this is an old post, but this should get you what you need:

Option Explicit

Sub ManageBookmarks()

Dim wdApp   As Object
Dim wdDoc   As Object
Dim wdName  As String
Dim wdTemp  As Object
Dim ws      As Worksheet
Dim LastRow As Long
Dim i       As Long

Set ws = ActiveSheet
wdName = "C:\Test.docx" 'Your file path here

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

If wdApp Is Nothing Then
    On Error GoTo 0
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open(wdName)
    wdApp.Visible = True
Else
    On Error GoTo 0
    For Each wdTemp In wdApp.Documents
        If StrComp(wdTemp.FullName, wdName, vbTextCompare) = 0 Then
            Set wdDoc = wdTemp
            Exit For
        End If
    Next wdTemp
    If wdDoc Is Nothing Then
        Set wdDoc = wdApp.Documents.Open(wdName)
    End If
End If

With ws
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow
        If .Cells(i, 1).Value = 1 Then
            If wdDoc.Bookmarks.Exists("sai" & i) = True Then
                wdDoc.Bookmarks("sai" & i).Delete
            End If
        End If
    Next i
End With

End Sub

This code assumes that your list of zeros and ones are in column A starting in row 1.

Put this code in your Excel file, set your worksheet to what you want, add your file name for wdName and you should be all set.

VBA to delete bookmark when Criteria not met in word document

1 Answers