Solved Channging Font Color of replaced text

Microsoft Microsoft excel 2007 (pc)
August 11, 2011 at 15:31:58
Specs: Windows XP
The script that DerbyDad03 provided for my last question was awesome. THANK YOU....But now I'm looking to do a little bit extra...

Can someone help me create a macro or tell me how to accomplish the following?

I have a Microsoft Excel Workbook with multiple Worksheets. I need to find a replace a given text string in the entire workbook. I also will need to change the font color of that text that was changed. I do not want to change the font color for the entire text string in the cell...just the text that was changed.


For example,..

Microsoft_Outlook_Workbook
Microsoft_Workbook_Outlook
Outlook_Microsoft_Workbook
may appear in any cells throughout the workbook (multiple worksheets/tabs). I need to replace "Outlook" with "Excel" and a simple find and replace all will change this. However, I need just "Excel" font color changed to orange while keeping the rest of the text string normal color. I can do this manually, but there are hundreds of times this may be changed, so clicking on each cell and highlighting just part of the text string and changing the font color is too time consuming.

I hope this makes sense.

Thanks in Advance


See More: Channging Font Color of replaced text

Report •


✔ Best Answer
August 12, 2011 at 20:51:21
I've got to admit that this was not as easy as I expected it to be.

I ended up with code that changes all occurrences of Outlook to Excel and then goes back and "fixes" the cells that contain MAC. (My assumption is that there are far more cells that don't contain Mac than do.)

This was due to a quirk in VBA's use Excel's Replace function that doesn't allow you to skip over cells and not change them.

Try this...

Sub ColorMeOrange()
'Loop through sheets
 For numSht = 1 To Sheets.Count
'Search all cells in sheet for "Outlook"
  With Sheets(numSht).Cells
   Set o = .Find("Outlook", LookIn:=xlValues, LookAt:=xlPart)
     If Not o Is Nothing Then
         firstAddress = o.Address
          Do
          'MsgBox o.Address
'If "Outlook" found, replace it with "Excel"
             o.Replace What:="Outlook", Replacement:="Excel", LookAt:=xlPart
'Find "Excel" within cell just changed and set Font Color to Orange
             o.Characters(Start:=InStr(1, o, "Excel"), Length:=5).Font.ColorIndex = 46
'Find the next "Outlook"
              Set o = .FindNext(o)
'Handle the error raised after last "Outlook" is replaced.
              On Error Resume Next
        Loop While Not o Is Nothing And o.Address <> firstAddress
    End If
 End With

'Fix MAC cells
  With Sheets(numSht).Cells
   Set m = .Find("MAC", LookIn:=xlValues, LookAt:=xlPart)
'If "MAC" found, replace "Excel" with "Outlook" and reset Font color
     If Not m Is Nothing Then
         firstAddress = m.Address
          Do
'Bring cell value into VBA, change it and put it back
            macCell = m.Value
            macCell = Replace(macCell, "Excel", "Outlook")
            Sheets(numSht).Range(m.Address) = macCell
            m.Font.ColorIndex = xlAutomatic
'Find the next "MAC"
              Set m = .FindNext(m)
        Loop While Not m Is Nothing And m.Address <> firstAddress
    End If
 End With
 Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
August 11, 2011 at 19:43:27
Modify as required:

Sub ColorMeOrange()
'Loop through sheets
 For numSht = 1 To Sheets.Count
'Search all cells in sheet for "Outlook"
  With Sheets(numSht).Cells
   Set c = .Find("Outlook", LookIn:=xlValues, LookAt:=xlPart)
     If Not c Is Nothing Then
         firstAddress = c.Address
          Do
'If "Outlook" found, replace it with "Excel"
            c.Replace What:="Outlook", Replacement:="Excel", LookAt:=xlPart
'Find "Excel" within cell just changed and set Font Color to Orange
            c.Characters(Start:=InStr(1, c, "Excel"), Length:=5).Font.ColorIndex = 46
'Find the next "Outlook"
              Set c = .FindNext(c)
'Handle the error raised after last "Outlook" is replaced.
              On Error Resume Next
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
 End With
 Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
August 12, 2011 at 11:13:22
Thanks again DerbyDad03...you came through again! This totally worked.

While I was testing this, I found that there might be a few exceptions in which I didn't want it to change. Is there a way to exclude a string?

For Example:
Microsoft_Outlook_Workbook
Microsoft_Workbook_Outlook
Outlook_Microsoft_MAC

Microsoft_Outlook_Workbook and Microsoft_Workbook_Outlook...I would like to change "Outlook" to "Excel" and mark those changes in orange (which works with your repsonse above), while leaving Outlook_Microsoft_MAC unchanged.

Does that make sense? Once again thank you for all of your help!


Report •

#3
August 12, 2011 at 15:16:16
In order to leave a given string unchanged, VBA would need to know something about the string that makes it candidate to be left alone.

In your example above (Outlook_Microsoft_MAC) you gave no indication as to why it shouldn't be changed.

Is it because it ends in MAC? Is it because Outlook starts in character position 1? Is it because it is in a certain range of cells?

VBA needs to given some sort of criteria upon which to base the decision to change the string or not.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
August 12, 2011 at 15:34:53
Sorry DerbyDad03 for not being specific enough. My bad.

For Example:
Microsoft_Outlook_Workbook
Microsoft_Workbook_Outlook
Outlook_Microsoft_Workbook
MAC_Outlook_Microsoft
Outlook_MAC_Microsoft
Microsoft_Outlook_MAC

Outlook would change to Excel except for where MAC is listed in the string. This string of text could be found anywhere in workbook (multiple tabs). So the criteria in where it doesn't change would be MAC, but for all other instances it would change. I hope that makes sense and clarify some questions you had


Report •

#5
August 12, 2011 at 20:51:21
✔ Best Answer
I've got to admit that this was not as easy as I expected it to be.

I ended up with code that changes all occurrences of Outlook to Excel and then goes back and "fixes" the cells that contain MAC. (My assumption is that there are far more cells that don't contain Mac than do.)

This was due to a quirk in VBA's use Excel's Replace function that doesn't allow you to skip over cells and not change them.

Try this...

Sub ColorMeOrange()
'Loop through sheets
 For numSht = 1 To Sheets.Count
'Search all cells in sheet for "Outlook"
  With Sheets(numSht).Cells
   Set o = .Find("Outlook", LookIn:=xlValues, LookAt:=xlPart)
     If Not o Is Nothing Then
         firstAddress = o.Address
          Do
          'MsgBox o.Address
'If "Outlook" found, replace it with "Excel"
             o.Replace What:="Outlook", Replacement:="Excel", LookAt:=xlPart
'Find "Excel" within cell just changed and set Font Color to Orange
             o.Characters(Start:=InStr(1, o, "Excel"), Length:=5).Font.ColorIndex = 46
'Find the next "Outlook"
              Set o = .FindNext(o)
'Handle the error raised after last "Outlook" is replaced.
              On Error Resume Next
        Loop While Not o Is Nothing And o.Address <> firstAddress
    End If
 End With

'Fix MAC cells
  With Sheets(numSht).Cells
   Set m = .Find("MAC", LookIn:=xlValues, LookAt:=xlPart)
'If "MAC" found, replace "Excel" with "Outlook" and reset Font color
     If Not m Is Nothing Then
         firstAddress = m.Address
          Do
'Bring cell value into VBA, change it and put it back
            macCell = m.Value
            macCell = Replace(macCell, "Excel", "Outlook")
            Sheets(numSht).Range(m.Address) = macCell
            m.Font.ColorIndex = xlAutomatic
'Find the next "MAC"
              Set m = .FindNext(m)
        Loop While Not m Is Nothing And m.Address <> firstAddress
    End If
 End With
 Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
August 15, 2011 at 10:11:09
Thanks again DerbyDad03! You are a rock star! I appreciate all your help with this!

Report •

#7
August 15, 2011 at 10:21:02
Hi DerbyDad03

Just one more question....Is there a way where I can get the Macro to skip a particular worksheet in the workbook? For example, I would like to have the Macro run through the entire Workbook except Worksheet 5. The entire Workbook is 12 worksheets, but don't need it to run on Worksheet 5 since this is a Product History Worksheet and doesn't need to be update.

Thanks!


Report •

Ask Question