find/replace from excel list to word doc not keeping original sentence case from excel list

[B13]

I have a VBA macro Redirecting that pulls scientific names from an excel sheet (sheet1, range A) and finds/replaces the s.names in the word document with the terms in the excel sheet. The code is supposed to change the font to bold, italic, color, and font type (Times new roman) and this portion works well. What doesn't work is changing the scientific names to sentence case, i.e. hyla cinerea or Hyla Cinerea or some other variant should be Hyla cinerea.

I've tried testing with other functions (e.g., wdUpperCase and wdLowerCase, WdCharacterCase enumeration (Word) | Microsoft Learn) which work, but are not the desired output. wdTitleSentence is what I want but when the code is run, it doesn't throw an error and the other formatting is still applied, but nothing changes with the text case unless it's in all caps, and then it goes to all lowercase. I also considered writing a function similar to some of the suggestions here: [RESOLVED] First letter in capital letter-VBForums but I'm not super savvy with VBA, so not sure if there is another existing function that exists that will accomplish this, or something else needs to occur. I did find Excel VBA Sentence Case Function and Converting to sentence case using VBA as potential help, but not sure how to incorporate this into the existing code. I will mention that the text in the excel has the desired case, so if there's a way to inherit the case from the excel file (and/or other formatting for that matter), that would be great. TIA for the help and I'm a first time poster, so apologies if this isn't correctly formatted.

VBA word code that works except for changing the case:
Sub format_scientific_names()
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim myarray As Variant
Dim FD As FileDialog
Dim strSource As String
Dim i As Long, lognum As Long
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.Title = "Select the workbook that contains the terms to be italicized"
.Filters.Clear
.Filters.Add "Excel Workbooks", "*.xlsx"
.AllowMultiSelect = False
If .Show = -1 Then
strSource = .SelectedItems(1)
Else
MsgBox "You did not select the workbook that contains the data"
Exit Sub
End If
End With
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open(strSource)
Set xlsheet = xlbook.Worksheets(1)
myarray = xlsheet.Range("A1").CurrentRegion.Value
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
For i = LBound(myarray) To UBound(myarray)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:=myarray(i, 1), Forward:=True, _


MatchWildcards:=True, Wrap:=wdFindStop, MatchCase:=False) = True
Set rng = Selection.Range
Selection.Collapse wdCollapseEnd
rng.Font.Italic = True
rng.Font.Bold = True
rng.Font.Color = RGB(200,187,0)
rng.Font.Name ="Times New Roman"
rng.Case= wdTitleSentence 'wdUpperCase works; this doesn't; something else I could put here?
Loop
End With
Next i
End Sub

[gmaxey]

Hello,


When you post code, it is helpful to simply post a snippet of the part that doesn't work. That way we don't have to try to recreate your entire situation (create and excel file etc.).


Try:

Sub format_scientific_names()
Dim oRng As Range
Dim strFind As String
  strFind = "Hyla cinerea"
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = strFind
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    While .Execute
      oRng.Font.Italic = True
      oRng.Font.Bold = True
      oRng.Font.Color = RGB(200, 187, 0)
      oRng.Font.Name = "Times New Roman"
      oRng.Case = wdLowerCase
      oRng.Words(1).Characters(1).Case = wdUpperCase
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  End Sub

Or you could simply use your Excel file "Find" phrase as the replacement text:

Sub format_scientific_names()
Dim oRng As Range
Dim strFind As String
  strFind = "Hyla cinerea"
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = strFind
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    While .Execute
      oRng.Text = strFind
      oRng.Font.Italic = True
      oRng.Font.Bold = True
      oRng.Font.Color = RGB(200, 187, 0)
      oRng.Font.Name = "Times New Roman"
      oRng.Collapse wdCollapseEnd
    Wend
  End With
End Sub

[B13]

Hi gmaxey, thanks for the tips on submitting and the speedy replies. I've tried the code you provided with a single scientific name, and it works exactly as expected. Thanks! However, in my lack of VBA knowledge, I'm struggling to incorporate it into the excel array that I call earlier in the code. I'm not quite sure what you mean by 'use your Excel file "Find" phrase as the replacement text'. Could you please elaborate a bit on this? Thanks!

[Italophile]

Have you checked that the array contains the values in the correct format? There is a difference between the Value and Text properties of an Excel Range. Text returns the formatted text whereas Value returns the underlying value. You could try changing:

myarray = xlsheet.Range("A1").CurrentRegion.Value

To:

myarray = xlsheet.Range("A1").CurrentRegion.Text

[gmaxey]

Change this section of your original code:

For i = LBound(myarray) To UBound(myarray)
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
    Do While .Execute(FindText:=myarray(i, 1), Forward:=True, _
    MatchWildcards:=True, Wrap:=wdFindStop, MatchCase:=False) = True
    Set rng = Selection.Range
    Selection.Collapse wdCollapseEnd
    rng.Font.Italic = True
    rng.Font.Bold = True
    rng.Font.Color = RGB(200,187,0)
    rng.Font.Name ="Times New Roman"
    rng.Case=  wdTitleSentence 'wdUpperCase works; this doesn't; something else I could put here?
     Loop

Next i

to:

Dim oRng As Range Dim strFind As String
   For i = LBound(myarray) To UBound(myarray)
    strFind = myarray(i)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = strFind
      .Forward = True
      .Wrap = wdFindStop
      .MatchCase = False
      While .Execute
         oRng.Font.Italic = True
         oRng.Font.Bold = True
         oRng.Font.Color = RGB(200, 187, 0)
         oRng.Font.Name = "Times New Roman"
         oRng.Case = wdLowerCase 
         oRng.Words(1).Characters(1).Case = wdUpperCase
         oRng.Collapse wdCollapseEnd
      Wend
   End With
   Next i

or the other variation I suggested.

[B13]

This worked! I did make minor tweaks to the code you provided in case someone else is looking at this:

Dim oRng As Range
Dim strFind As String
vs
Dim oRng As Range Dim strFind As String 'on one line

and
strFind = myarray(i, 1)
vs
strFind = myarray(i) 'which returns a subscript out of bounds error

Thanks again, this is a lifesaver and will save a lot of formatting time in the future!