replace texts of table cells with specified texts

setup

i've come across a journal that's quite specific about formatting. one of the specifications was to replace all "0", which means zero incidence of an adverse event, with "0 (0)" when the former is the only text inside a table cell. i'd like to automate this process.

solution

the plan

  1. loop over all tables in the active document.
  2. inside each table, loop over all cells. have to be able to deal with tables with merged rows or cells.
  3. inside each cell, get its text and replace the text if == '0'.
  4. better yet, make a function so i can specify the strings to be replaced, instead of just "0"s. then, call that function and pass it with toBeReplaced and replaceWith strings.

programming language & module(s)

  • VBA

file preps

make the doc to be processed the active document, i.e. the one where the cursor currently is in.

variables to customize

  • toBeReplaced
  • replaceWith

the script

replaceZeroInci
Sub replaceZeroInci()

    Dim doc As Document

    Dim trkRevStatus As Boolean

    Dim selStart, selEnd, safeCount As Long

    Dim lan As String

    

    Application.ScreenUpdating = False

    System.Cursor = wdCursorWait

    Set doc = ActiveDocument

    trkRevStatus = doc.TrackRevisions

    doc.TrackRevisions = False

    

    replaceCellTxtSub doc, "0", "0.0"

    

    doc.TrackRevisions = trkRevStatus

    System.Cursor = wdCursorNormal

    Application.ScreenUpdating = True

End Sub



Sub replaceCellTxtSub(ByVal doc As Document, ByVal toBeReplaced As String, ByVal replaceWith As String)

    For Each tbl In doc.Tables

        For i = 1 To tbl.Rows.Count

            Set row = tbl.Rows(i)

            For j = 1 To row.Cells.Count

                txt = fGetCellTxt(row.Cells(j))

                If txt = toBeReplaced Then

                    row.Cells(j).Range.Text = replaceWith

                End If

            Next j

        Next i

    Next tbl

End Sub



Function fGetCellTxt(ByVal c As cell) As String

    Dim txt As String

    

    txt = Replace(c.Range.Text, Chr(13), "")

    txt = Replace(txt, Chr(7), "")

    txt = Trim(txt)

    fGetCellTxt = txt

End Function

output

here's some small-scale test results. notice the changes in the first columns of the tables. image.png

note to self

  • [tbd]
replacing table VBA
Some rights reserved
Except where otherwise noted, content on this page is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International license.