MS Word VBA help needed

[richiwatts]

I hope this is understandable:

I have a template that scans a current Word document for words that match those in a separate text file.

If a match is found it highlights the word and I can then run another Macro on the highlighted word which will pop up a window and show me all the other words on the same line in the text file, I can then choose another word – a bit like synonyms.

The first couple of lines in the text file looks like this:
acclamation acclimation
acts ax (*) axe (*)
ad add
adds ads adze (*) adz (*)
adieu ado
aerie (*) eyrie (*) airy

Words that are followed by “space(*)” represent words that are spelt differently but mean the same.

The problem I have is that I need (*) to show in the window that pops up but not placed into the Word document if I select that word. e.g if the word “acts” in my document was highlighted and I run my second Macro the window that pops up should look like this:
acts
ax (*)
axe (*)
If I then decide to change the word to “ax” I can select it and it would replace “acts” with “ax” and not “ax (*).

I already have the code that makes the idea work but the code I have doesn’t show the (*) in the window. How would I change it so that it does show up in the window but not in the document I would be grateful if someone could take a look through my code or post back if something is not clear.

Private Sub UserForm_Activate()
Dim LineString As String
Dim TextFromDocument As String
Dim path As String
Dim WordArray As Variant
Dim bFound As Boolean, nFoundPos As Integer
Dim indx As Integer, LparenPos As Integer, RparenPos As Integer

If Selection.FormattedText.HighlightColorIndex <> wdTurquoise Then
Me.Hide
MsgBox &quot;Please make sure the cursor is over a highlighted word&quot;
bOK = False
Exit Sub
End If

TextFromDocument = LCase(HomonymRange.Text)

' Use your own path and file name
path = ThisDocument.path
Open path & Application.PathSeparator & &quot;data.txt&quot; For Input As #1
bFound = False
Do While (Not EOF(1)) And (Not bFound)
Line Input #1, LineString
LparenPos = InStr(LineString, &quot;(&quot
Do While LparenPos > 0
RparenPos = InStr(LparenPos, LineString, &quot&quot
If RparenPos > 0 Then
LineString = Left(LineString, LparenPos - 2) & _
Right(LineString, Len(LineString) - RparenPos)
LparenPos = InStr(LineString, &quot;(&quot
End If
Loop

WordArray = Split(LineString, vbTab)
For indx = 0 To UBound(WordArray)
If WordArray(indx) = TextFromDocument Then
bFound = True
Exit For
End If
Next indx
Loop
Close #1

If Not bFound Then
Me.Hide
MsgBox &quot;Could not find homonyms for &quot; & TextFromDocument
bOK = False
Exit Sub
End If

lbSuggestions.List = WordArray
End Sub

 

[sfvb]

Instead of parsing out the “space(*)” before the user makes a selection from the pop-up window, you could parse the “space(*)” out afterwards.

Open path & Application.PathSeparator & &quot;data.txt&quot; For Input As #1
bFound = False
Do While (Not EOF(1)) And (Not bFound)
Line Input #1, LineString

WordArray = Split(LineString, vbTab)
For indx = 0 To UBound(WordArray)
If WordArray(indx) = TextFromDocument[/color] Or WordArray(indx) = TextFromDocument & &quot; (*)&quot; Then
bFound = True
Exit For
End If
Next indx
Loop
Close #1

After the user makes the selection, use the Replace function to parse out the “space(*)”, if it exists. Ex:

WordToReplace = Replace(WordToReplace, &quot; (*)&quot;, &quot;&quot

 

[richiwatts]

The first bit you mentioned works if the word in the Word document is
&quot;acts&quot;
But if the highlighted word in the document is
&quot;ax&quot;
and I try to run the macro on it I get the message for &quot;if not found&quot;

Is it because &quot;ax&quot; in hte word document would not be the same as &quot;ax (*)&quot; in hte text file?

How can I get around this? Thanks for the help!

 

[sfvb]

If WordArray(indx) = &quot;ax (*)&quot;, but the TextFromDocument = &quot;ax&quot;, this part of code:

Or WordArray(indx) = TextFromDocument & " (*)"

is appending a &quot; (*)&quot; to the TextFromDocument. So the comparison will be True.

If you are getting the &quot;Could not find homonyms...&quot; message, then either you have more than one space before the &quot;(*)&quot;, or there is no Tab after the “space(*)”

Here's an example, that shows it works

   LineString = "acts" & vbTab & "ax (*)" & vbTab & "axe (*)"
   TextFromDocument = "ax"
   WordArray = Split(LineString, vbTab)
   
   For indx = 0 To UBound(WordArray)
      If WordArray(indx) = TextFromDocument Or WordArray(indx) = TextFromDocument & " (*)" Then
         bfound = True
         Exit For
      End If
   Next indx
   
   If bfound = True Then
      MsgBox "True"
   Else
      MsgBox "False"
   End If

 

[richiwatts]

Sorry sfvb

that did work! I was using the wrong text file which has (x) instead of (*) after the words.
Instead of having
WordArray(indx) = TextFromDocument & &quot; (*)&quot;
Is it possible to have
WordArray(indx) = TextFromDocument & &quot; (anything here)&quot;

I have just had your reply message pop up &quot;sorry for not getting this back quicker!!!

I would be really grateful if you could explain the replace part a bit clearer as i am a bit of a beginner.

Thanks for bearing with me

 

[sfvb]

The full sytax for the Replace function is:

Replace(expression, find, replace[, start[, count[, compare]]])

but the examples I'm going to use, do not include the optional arguments, so the syntax would actually look more like this:

Replace(expression, find, replace)

Here are some examples:

OrigText = "ax (*)"
WordToReplace1 = Replace(OrigText, " (*)", "gh")
WordToReplace2 = Replace(OrigText, " (*)", "")

'WordToReplace1 is now equal to "axgh"
'WordToReplace2 is now equal to "ax"

OrigText = "ax (*) (*)"
WordToReplace1 = Replace(OrigText, " (*)", "gh")
WordToReplace2 = Replace(OrigText, " (*)", "")

'WordToReplace1 is now equal to "axghgh"

NOTE: each occurrence got replaced

'WordToReplace2 is now equal to "ax"

OrigText = "ax"
WordToReplace1 = Replace(OrigText, " (*)", "gh")

'WordToReplace1 is now equal to "ax"

NOTE: the &quot; (*)&quot; string was not found within the variable OrigText, so no replacements took place.


Here's two examples that will change the highlighted text in the document, based on the users selection from the listbox.

Private Sub lbSuggestions_Click()
   Dim WordToReplace    As String
   
   WordToReplace = Replace(lbSuggestions.Text, " (*)", "")
   Selection.TypeText Text:=WordToReplace 
End Sub

Private Sub lbSuggestions_Click()
   Selection.TypeText Text:=Replace(lbSuggestions.Text, " (*)", "")
End Sub

 

[sfvb]

Is it possible to have
WordArray(indx) = TextFromDocument & &quot; (anything here)&quot;

I forgot to answer that question. The answer is yes.

If, for example, your word list looked like this:
acclamation acclimation
acts ax!! axe!!
...
then you would want:
If WordArray(indx) = TextFromDocument Or WordArray(indx) = TextFromDocument & &quot;!!&quot; Then
...

 

[richiwatts]

Thank you!

I am completly lost as to which code i need to use for the replace so I will have a look and play around with it tomorrow.

With regards to the second question, what I really meant was can I have any text between the () without them all being the same. The reason i need this is because i eventually want to put the word's definition after every word e.g
there (He is standing over there&quot;
their (It was their turn)
they're (They are)

Richi

 

[sfvb]

can I have any text between the () without them all being the same.

No. Given the example you've shown, I would change the code so that it's comparing a truncated wordArray to the TextFromDocument, instead of comparing the wordArray value an appended TextFromDocument. For example:

    Open path & Application.PathSeparator & "data.txt" For Input As #1
    bFound = False
    Do While (Not EOF(1)) And (Not bFound)
        Line Input #1, LineString
        
        WordArray = Split(LineString, vbTab)
        For indx = 0 To UBound(WordArray)
           intPos = InStr(1, WordArray(indx), " (")
           If intPos > 0 Then
              TestWord = Left(WordArray(indx), intPos - 1)
           Else
              TestWord = WordArray(indx)
           End If
           If TestWord = TextFromDocument Then
              bFound = True
              Exit For
           End If
        Next indx
    Loop
    Close #1

Also, I would change the code that does the actual replacing of the selected text in the document.

Private Sub lbSuggestions_Click()
   Dim WordToReplace    As String
   Dim intPos           As Integer

   intPos = InStr(1, lbSuggestions.Text, " (")
   If intPos > 0 Then
      WordToReplace = Left(lbSuggestions.Text, intPos - 1)
   Else
      WordToReplace = lbSuggestions.Text
   End If
   
   Selection.TypeText Text:=WordToReplace 
End Sub