VBA word words hightlight

Sub HighlightWords()
Dim WORDS() As String
ReDim Preserve WORDS(0)
'
AddStringValue WORDS, "тип"
AddStringValue WORDS, "должен"
'
For Each sentence In ActiveDocument.StoryRanges
    For Each w In sentence.WORDS
     If IsInArray(LCase(Trim(w.Text)), WORDS) Then
        ActiveDocument.Range(w.Start, w.End - 1).HighlightColorIndex = wdYellow
     End If
 Next
Next
End Sub

Private Sub AddStringValue(ByRef Arr As Variant, ByVal Value As String)
If UBound(Arr) = 0 And Len(Arr(0)) = 0 Then
    Arr(0) = Value
Else
    ReDim Preserve Arr(UBound(Arr) + 1)
    Arr(UBound(Arr)) = Value
End If
End Sub

Private Function IsInArray(valToBeFound As Variant, Arr As Variant) As Boolean
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
    For Each element In Arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function