How to find table column, then move down and replace the cell's content IF it is "N/A"

Question

I have almost 1,800 Word documents that have about 8 pages with unique data in tables. We were just informed that the data we were given for some of those tables is inaccurate and needs to be changed from "N/A" to "0.0%". As "N/A" is used a lot in the document, I unfortunately cannot just find/replace that text.

Using this thread (Macro to find in Word table for specific string in a cell and move x cell left, check isnumeric then set typography on down x cell in the same column) I was able to adjust the code below to find the column header (On-Time Completion Rate) and move to the adjacent cells to update them. However, since this column is for percentages, the IsNumeric code is changing any data it finds due to the percentage symbol.

Is there a way to do the same but instead of using IsNumeric (since it does not work for percentages) check the value in the cell and if it finds "N/A" change it to "0.0%"? This would then need to be repeated for two more tables, with one table have four rows to look through.

Thank you in advance for any help you can offer!

Screenshot of table

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "On-time Completion Rate" 'Column Header'
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Information(wdWithInTable) = True Then
      r = .Cells(1).RowIndex
      c = .Cells(1).ColumnIndex
      With .Tables(1)
             If Not IsNumeric(Split(.Cell(r + 1, c).Range.Text, vbCr)(0)) Then .Cell(r + 1, c).Range.Text = "0.0%"
        If Not IsNumeric(Split(.Cell(r + 2, c).Range.Text, vbCr)(0)) Then .Cell(r + 2, c).Range.Text = "0.0%"
      End With
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

Answer 1

Try this:

Sub Demo()
   Application.ScreenUpdating = False
   Dim r As Long, c As Long
   With ActiveDocument.Range
      With .Find
         .ClearFormatting
         .Replacement.ClearFormatting
         .Text = "On-time Completion Rate" 'Column Header'
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchWildcards = True
         .Execute
      End With
      Do While .Find.Found
         If .Information(wdWithInTable) = True Then
            r = .Cells(1).RowIndex
            c = .Cells(1).ColumnIndex
            With .Tables(1)
               If Split(.Cell(r + 1, c).Range.Text, vbCr)(0) = "N/A" Then .Cell(r + 1, c).Range.Text = "0.0%"
               If Split(.Cell(r + 2, c).Range.Text, vbCr)(0) = "N/A" Then .Cell(r + 2, c).Range.Text = "0.0%"
            End With
         End If
         .Collapse wdCollapseEnd
         .Find.Execute
      Loop
   End With
   Application.ScreenUpdating = True
End Sub