CODEWITHSUNDEEP
vbams-word
ninja97
ninja97

Reputation: 29

Find any occurrence of multiple words and change their color and make bold

I am trying to make my macro bring up a search box that allows me to enter as many words as I want, separated by comma, and then find each word in the list in the document and make them bold and blue. I my code isn't working.

I'm at my wits and and this should have been a simple macro to write in 5 minutes. I am new at this, of course.

Sub BlueWords()
  Dim blueword As String
  Dim numberofwords As Long

  Application.ScreenUpdating = False

  ' Enter words that need to become bold blue words.
  blueword = InputBox("Enter items to be found here,seperated by comma: ", "Items to be found")
  numberofwords = UBound(Split(blueword, ","))

 ' Find each item and replace it with new one respectively.
  For numberofwords = 0 To numberofwords
    With Selection
      .HomeKey Unit:=wdStory
      With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Split(blueword, ",")(numberofwords)
        .blueword.Font.Color.RGB = Split(RGB(255, 0, 0), ",")(numberofwords)
        .Format = False
        .MatchWholeWord = False
      End With
    Selection.Find.Execute Replace:=wdReplaceAll
  End With
Next numberofwords

  Application.ScreenUpdating = True

End Sub

I expect it to work, but I think it all goes off the rails where I'm trying to make the code actually perform the bold and blue part. Of course, it won't run.

Upvotes: 0

Views: 357

Answers (2)

Legxis
Legxis

Reputation: 916

The below code works like this

  • startSearch saves the input from the input box as a string, splits it into an array and loops over the individual words. In each loop, it calls findCells.
  • findCells uses the .Find function to search the selected range (before you start the macro) for cells that contain the word of the current loop. Then it loops over the found range (making sure not to get into an infinite loop) and calls modifyCell.
  • modifyCell disables the change event and makes the celltext blue and bold.

startSearch:

Sub startSearch()

  Dim inputString As String
  Dim inputArray() As String
  Dim wordsArray() As Variant
  Dim selRange As Range

  Application.ScreenUpdating = False

  ' Enter words that need to become bold blue words.
  inputString = InputBox("Enter items to be found here,seperated by comma: ", "Items to be found")
  inputArray = Split(inputString, ",")

  ' Create Array out of input.
  ReDim wordsArray(LBound(inputArray) To UBound(inputArray))
  Dim index As Long

  For index = LBound(inputArray) To UBound(inputArray)
    wordsArray(index) = inputArray(index)
  Next index

 ' Determine Selection
  Set selRange = Selection

 ' Loop through array/each word and find them in a range (then modify them).
  For Each word In wordsArray

    Call findCells(selRange, word)

  Next word

  Application.ScreenUpdating = True

End Sub

findCells:

Private Sub findCells(searchRange, content)

    Dim foundCell As Range
    Dim firstFound As String

    With searchRange

'   Find range of cells that contains relevant word
    Set foundCell = .Find(What:=content, _
                          After:=.Cells(.Cells.Count), _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, _
                          MatchCase:=False)

'       If any cells containing the word were found, then modify them one by one
        If Not foundCell Is Nothing Then

'           Save first found cell, LOOP over found cells, modify them, go to next cell, until back to the first one
            firstFound = foundCell.Address

            Do
                Call modifyCell(foundCell)
                Set foundCell = .FindNext(foundCell)
            Loop Until foundCell.Address = firstFound

        End If

    End With

End Sub

modifyCell:

Private Sub modifyCell(TargetCell As Range)

' disable change event while modifying cells
Application.EnableEvents = False

TargetCell.Font.Color = RGB(0, 0, 255)
TargetCell.Font.Bold = True

Application.EnableEvents = True

End Sub

Upvotes: 1

AJD
AJD

Reputation: 2438

This line of code .blueword.Font.Color.RGB = Split(RGB(255, 0, 0), ",")(numberofwords) will not work.

  • RGB() will return a number representing a colour. So the Split returns an array of 1 (index = 0). As a result, your line of code will cause an 'index out of bounds' error.
  • .blueword is not a member of Find
  • .Font.Color.RGB = RGB(0,0,255) should turn the text blue easily enough!

There are other issues in the code, and you will probably come across other errors.

Instead of using Split so many times, why not save it to an array variable and just loop through the array - so much cleaner!

Upvotes: 0

Related Questions