vba to automate word tables with single arrays

[Randy413]

Using Office 2007;

I have a word table that I use to track stock values. The table has a list of stock symbols that I need to occasionally change.

I am using vba to find and replace the symbols in the table. Right now I use "inputbox" to list the existing symbols in the table and again to list the new symbols. The code works fine, however, I would like vba to find the existing symbols in the table and I will continue to use the "inputbox" to change the list. The tables are single array and can vary from 3 rows to 12 rows determined by my old method of inputting the symbols manually. VBA would need to count the number of rows used in each table from 3 to 12 (each table has only 3, 4, 5, ...12 rows etc)

Here is my code:
Sub replaceSymbols()
Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Range, i As Long

' the code between the = signs is what I would like to automate. I.E. vba would identify
' the current (oldSym) symbols and enter them in the code here: .Text = Split(oldSym, ",")(i)
' and I will continue to manually enter the new symbols in: newSym=Imputbox...

'========
oldSym = InputBox(prompt:="Old Symbols", Title:="List old symbols separated by commas")
'========
newSym = InputBox(prompt:="New Symbols", Title:="Replace with new symbols separated by commas")
For i = 0 To UBound(Split(oldSym, ","))
Set Rng = ActiveDocument.Range
With Rng.Find
.ClearFormatting
.Text = Split(oldSym, ",")(i)
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = Split(newSym, ",")(i)
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
.Execute Replace:=wdReplaceAll
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[gmaxey]

Sub replaceSymbols()
Dim oTbl As Word.Table
Dim strSymbols As String
Dim lngIndex As Long
Dim arrFind() As String, arrReplace() As String
Dim strFind As String, oRng As Range
Set oTbl = ActiveDocument.Tables(1)
For lngIndex = 2 To oTbl.Rows.Count
If Len(oTbl.Rows(lngIndex).Cells(1).Range.Text) > 2 Then
strSymbols = strSymbols & "|" & Left(oTbl.Rows(lngIndex).Cells(1).Range.Text, Len(oTbl.Rows(lngIndex).Cells(1).Range.Text) - 2)
Else
Exit For
End If
Next lngIndex
strSymbols = Mid(strSymbols, 2, Len(strSymbols) - 1)
Application.ScreenUpdating = False
arrFind = Split(strSymbols, "|")
Do
arrReplace = Split(InputBox(prompt:="New Symbols", Title:="Replace with new symbols separated by commas"), ",")
Loop Until UBound(arrReplace) = UBound(arrFind)
For lngIndex = 0 To UBound(arrFind)
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = arrFind(lngIndex)
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = arrReplace(lngIndex)
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
.Execute Replace:=wdReplaceAll
End With
Next
Set oRng = Nothing
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

[Randy413]

Greg, works great. I couldn't figure out how to build the array that was already part of the table to do the "find" portion. I followed your code and understand how it's done. THANKS

[gmaxey]

Randy, you're welcome.

[Randy413]

Greg,
I found an anomaly in the code.
.Execute Replace:=wdReplaceAll

I know we need this code in the total process, however, here is what happens when there are stock symbols such as: AAPL, BA, BABA, BBEP,VLO in the array.
I enter this new array: AAPL,B,BAC,VLO,D and get this one: AAPL,B,BB,D,D. I've run several scenarios that I actually use like the one above and learned
if their are symbols with the same letters in each one; the code does not see them as whole words even though .MatchWholeWord = True is in there.
The scenario above, for me, is common to own these companies at the same time.
The code works fine if there are no similar symbols in the "old" or "original" array.
Can this be tweaked?
RP

[gmaxey]

Randy,

I don't see that as an anomaly. There are two problems with what you have tried to do. First .MatchWholeWord and .MatchAllWordForms are mutually exclusive. If you set .MatchAllWordForms = True the .MatchWholeWord is disabled and false.

That explains why you are getting AAPL, B, BB. The reason you are getting D, D is because you are replacing BBEP with VLO in the fourth iteration of the loop in your code and then replacing VLO (both instances) with D in the fifth iteration.