Word Dynamic Array

[colins5286]

Hi,

I am creating a script that will go through a word document and highlight instances of key phrases.
I have created an array "Sales Figures", "Token", "Party Line String". When this is hardcoded into the VBA it works fine and highlights any instance found. What I would like to do is have a form with a text box on it that a user can populate with their search string. I can only get the VBA to read the very first word in my text box though.

My code is below:


Private Sub CommandButton1_Click()
Dim range As range
Dim i As Long
Dim TargetList




TargetList = Array(TextBox1) ' put list of terms to find here
'TargetList = Array("Sales Figures", "Token", "Party Line String") 'Hardcoded List


For i = 0 To UBound(TargetList)


Set range = ActiveDocument.range


With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False


Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow


Loop


End With
Next
End Sub


I've attached a screenshot of my userform too.
20182

Any help would be much appreciated.
Thanks

[mana]

Split function


Option Explicit


Sub test()
Dim k As String
Dim s

k = InputBox("keywords List separated by comma")
If k = "" Then Exit Sub
s = Split(k, ",")
MsgBox s(LBound(s))
MsgBox s(UBound(s))


End Sub

[Paul_Hossler]

Not tested and no error checking




Private Sub CommandButton1_Click()
Dim range As range
Dim i As Long
Dim TargetList As Variant



'No quotes around strings, and separated by commas
TargetList = Split (TextBox1.Caption, ",") '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


For i = LBound(TargetList) To UBound(TargetList)


Set range = ActiveDocument.range


With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False


Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow


Loop


End With
Next
End Sub

[colins5286]

Thanks very much. Works a treat.