Thread: [Solved] Use wildcards in word VBA
View Single Post
 
Old 05-24-2023, 08:28 PM
Guessed's Avatar
Guessed Guessed is online now Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,978
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Looks like a couple of problems there.

Firstly, if you want the Excel list to include more than one column of info then you need to set the named range to include the other columns.

Secondly, your code is not including the wildcard search parameter. You can choose to turn it on for all searches or get the script to include it only if you have a T in the third column. This code change includes it as a variable. Note that I've added a MatchCase = False so a regular search won't be case sensitive and you won't need wildcards turned on.
Code:
Sub Highlight_Words_From_Excel_NamedRange()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Mar 2020
Const strWorkbook As String = "C:\Users\locktonai\Documents\aaa\WordList.xlsx" 'The workbook path
Const strRange As String = "WordList" 'The named Excel range
Dim arr() As Variant, lngRows As Long, oRng As Range, strFind As String, bWC As Boolean
  arr = xlFillArray(strWorkbook, strRange)
  For lngRows = 0 To UBound(arr, 2)
    strFind = arr(0, lngRows)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .MatchCase = False
      bWC = arr(2, lngRows) = "T"   'assumes named range includes at least 3 columns with no empty cells
      .MatchWildcards = bWC
      Do While .Execute(findText:=strFind)
        oRng.HighlightColorIndex = wdYellow
        oRng.Collapse 0
      Loop
    End With
  Next lngRows
lbl_Exit:
  Exit Sub
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote