Find & Replace using Macro in Word

[rajtilak]

Sub FindRiskWords()


Dim oRng As Word.Range
Dim arrExcelValues()
Dim arrExcelValues1()
Dim i As Long
Dim x As Long


Set objExcel = CreateObject("Excel.Application")
Set objExcel1 = CreateObject("Excel.Application")


Set objWorkbook = objExcel.Workbooks.Open("\\path")
objExcel.Visible = False


i = 1
x = 0


Set objWorkbook1 = objExcel1.Workbooks.Open("\\path")
objExcel1.Visible = False


j = 1
y = 0


Do Until objExcel.Cells(i, 1).Value = ""
   ReDim Preserve arrExcelValues(x)
   arrExcelValues(x) = objExcel.Cells(i, 1).Value
   i = i + 1
   x = x + 1
Loop
objExcel.Quit


Do Until objExcel1.Cells(j, 2).Value = ""
    ReDim Preserve arrExcelValues1(y)
    arrExcelValues1(y) = objExcel1.Cells(j, 2).Value
    j = j + 1
    y = y + 1
Loop
objExcel1.Quit


Word.Application.Activate


For i = 0 To UBound(arrExcelValues)
    Set oRng = ActiveDocument.Range
    'Options.DefaultHighlightColorIndex = wdYellow
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = arrExcelValues(i)
        .Replacement.Text = arrExcelValues1(i)
        .MatchWholeWord = True
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
    End With
Next


End Sub

This code is supposed to find words from an Excel, match is with the corresponding word in another column from that Excel, find those words in a Word file and then replace those words. It's working perfectly except for a small hiccup. When the word found begins with a capital letter, the replaced word is in all caps even if its given in a sentence case in the Excel.