Thread: Text removal
View Single Post
 
Old 03-23-2022, 10:05 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

There is no way to determine whether the words you want to keep are different from the words you want to discard, when both are formatted as US English, as in your example. The only practical solution I can think of is to check against a predefined list, which is the solution adopted below. The error relates to the fact that your current example document has merged cells, which are more difficult to work with. However the following works with your example document. You can add words and/or phrases to the array if your tables have different combinations of strings in the cells.
Code:
Sub Macro1()
Dim vList As Variant
Dim oTable As Table
Dim oCell As Cell
Dim i As Long
Dim oRng As Range
Dim sText As String
Dim bOmit As Boolean

    vList = Array("Goodwill", "Income", "Net Cost", "A") 'The words to ignore when they appear to the left of the '/' character.

    Set oTable = Selection.Tables(1)
    With oTable
        For Each oCell In oTable.Range.Cells
            Set oRng = oCell.Range
            oRng.Case = wdTitleWord
            If InStr(1, oRng.Text, "/") > 0 Then
                sText = Split(oRng.Text, "/")(0)
                If IsNumeric(sText) = False Then
                    bOmit = False
                    For i = 0 To UBound(vList)
                        If CStr(vList(i)) = sText Then
                            bOmit = True
                            Exit For
                        End If
                    Next i
                    If bOmit = False Then
                        oRng.Text = Trim(Split(oRng.Text, "/")(1))
                    End If
                End If
            End If
        Next oCell
    End With
    Set oTable = Nothing
    Set oRng = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote