VBA to search & highlight text in string

[ajdifonzo]

Hi,

I'm trying to search for and highlight specific text in a string that could be there more than once. The list of text that I want to search for is in a column on another tab.

in the attached files the Data tab has the area I want to search, column "E", the Search Values tab has the list of values I want to search for.

 

[6StringJazzer]

Please define what you want the highlighting to look like.

 

[ajdifonzo]

Please define what you want the highlighting to look like.

Highlight any value found in Bold Red.

 

[6StringJazzer]

Add this code to a standard module (e.g., Module1) in your file and Run Macro.

Option Explicit

Public Sub HighlightText()

   Dim DataRow As Long
   Dim TextSheet As Worksheet
  
   Set TextSheet = Worksheets("Data")
  
   DataRow = 1
   Do Until TextSheet.Cells(DataRow, "E") = ""
  
      HighlightTextCell TextSheet.Cells(DataRow, "E")
     
      DataRow = DataRow + 1
     
   Loop

   MsgBox "Highlighting complete."
  
End Sub

Public Sub HighlightTextCell(Cell As Range)

   Dim KeySheet As Worksheet
   Dim KeyRow As Long
   Dim StartPos As Long
   Dim Key As String
  
   Set KeySheet = Worksheets("Search Values")
  
   KeyRow = 1
   Do Until KeySheet.Cells(KeyRow, "A") = ""
  
      Key = KeySheet.Cells(KeyRow, "A")
     
      StartPos = 1
      Do Until StartPos = 0

         StartPos = InStr(StartPos, Cell.Value, Key)
         If StartPos > 0 Then
            Cell.Characters(StartPos, Len(Key)).Font.Color = RGB(255, 0, 0)
            Cell.Characters(StartPos, Len(Key)).Font.Bold = True
            StartPos = StartPos + Len(Key)
         End If
      Loop
  
      KeyRow = KeyRow + 1
  
   Loop

End Sub

 

[ajdifonzo]

Add this code to a standard module (e.g., Module1) in your file and Run Macro.

Option Explicit

Public Sub HighlightText()

   Dim DataRow As Long
   Dim TextSheet As Worksheet
 
   Set TextSheet = Worksheets("Data")
 
   DataRow = 1
   Do Until TextSheet.Cells(DataRow, "E") = ""
 
      HighlightTextCell TextSheet.Cells(DataRow, "E")
    
      DataRow = DataRow + 1
    
   Loop

   MsgBox "Highlighting complete."
 
End Sub

Public Sub HighlightTextCell(Cell As Range)

   Dim KeySheet As Worksheet
   Dim KeyRow As Long
   Dim StartPos As Long
   Dim Key As String
 
   Set KeySheet = Worksheets("Search Values")
 
   KeyRow = 1
   Do Until KeySheet.Cells(KeyRow, "A") = ""
 
      Key = KeySheet.Cells(KeyRow, "A")
    
      StartPos = 1
      Do Until StartPos = 0

         StartPos = InStr(StartPos, Cell.Value, Key)
         If StartPos > 0 Then
            Cell.Characters(StartPos, Len(Key)).Font.Color = RGB(255, 0, 0)
            Cell.Characters(StartPos, Len(Key)).Font.Bold = True
            StartPos = StartPos + Len(Key)
         End If
      Loop
 
      KeyRow = KeyRow + 1
 
   Loop

End Sub

Thank you very much. this worked like a charm and saved me hours.

 

[6StringJazzer]

Glad to help! I tested it but am always happy to hear it worked on your side too.

 

[Sia]

Add this code to a standard module (e.g., Module1) in your file and Run Macro.

Option Explicit

Public Sub HighlightText()

   Dim DataRow As Long
   Dim TextSheet As Worksheet
 
   Set TextSheet = Worksheets("Data")
 
   DataRow = 1
   Do Until TextSheet.Cells(DataRow, "E") = ""
 
      HighlightTextCell TextSheet.Cells(DataRow, "E")
    
      DataRow = DataRow + 1
    
   Loop

   MsgBox "Highlighting complete."
 
End Sub

Public Sub HighlightTextCell(Cell As Range)

   Dim KeySheet As Worksheet
   Dim KeyRow As Long
   Dim StartPos As Long
   Dim Key As String
 
   Set KeySheet = Worksheets("Search Values")
 
   KeyRow = 1
   Do Until KeySheet.Cells(KeyRow, "A") = ""
 
      Key = KeySheet.Cells(KeyRow, "A")
    
      StartPos = 1
      Do Until StartPos = 0

         StartPos = InStr(StartPos, Cell.Value, Key)
         If StartPos > 0 Then
            Cell.Characters(StartPos, Len(Key)).Font.Color = RGB(255, 0, 0)
            Cell.Characters(StartPos, Len(Key)).Font.Bold = True
            StartPos = StartPos + Len(Key)
         End If
      Loop
 
      KeyRow = KeyRow + 1
 
   Loop

End Sub

Hi,

6StringJazzer,​

I hope you are doing well.
For me the solution that you gave via that code will be useful as well. There is only one adjustment needed. I will truly appreciate if you advise me. Instead of highlighting the founded words/text, i need that text to be copied into the next cell & searching should be : cell by cell for the whole column . Please check at the screenshots. You could see that there is words from column "C" which were allocated in column "D", that is perfect. Unfortunately it is working only for one cell - "C2", not for all cell's from column C - C3,C4,C5 etc. Thanks a lot in advance. Regards!

 

[6StringJazzer]

There is only one adjustment needed

Hi Sia,

This is not an adjustment, this is a whole new problem. I don't have time to address it at the moment. You will get more attention to your question if you post it as a new thread instead of piggybacking on this one.

 

[Sia]

This is not an adjustment, this is a whole new problem. I don't have time to address it at the moment. You will get more attention to your question if you post it as a new thread instead of piggybacking on this one.

Thank you!