VBA String Manipulations - Parsing Strings - 2

Parsing a String in a Cell based on its color,

change it and write back the result

   I assume here that the colored text is found at the middle or end of the string (for example:
   "This string has some color"). For other color combinations in the cells,
   like color at start, changes of color, this requires a much more complicated macro.

Sub Change_Part_of_String_in_Cell_Based_on_Its_Color()
' ______________________________________
'
' This VBA macro works in Excel
' ______________________________________
'
Dim myString, String_to_Parse, Front_String, Back_String As String
Dim myStartRow, myEndRow, myColData, myColResult As Long

myEndRow = 8            'Define on which row to end
myColData = 7           'Define the column number where is the data
myColResult = 11        'Define the column where to put the result

For myStartRow = 2 To myEndRow     'Define the Start Row and the End Row
 cells(myStartRow, myColData).Select
 myString = selection

 For i = 1 To ActiveCell.Characters.count
 'Loop through the characters inside the cell to find if
 'there is a font with some color.

  If (ActiveCell.Characters(i, 1).Font.Color <> vbAutomatic) Then

   'If there is some color, this color will
   'be found at the position of i in the loop.
   'Then extract the piece of string that has the color
   'and do what you want with it.

   'Here I'm giving this piece of colored text some HTML code, and then
   'I piece together the front of the string and the back of the string
   'with the new stuff and then writing the result in some other cell
  
    String_to_Parse = myString
    Front_String = Mid(myString, 1, i - 1)
    Back_String = Mid(myString, i)
   cells(myStartRow, myColResult).Value = Front_String & "<font color=""#800000""><b> " & _
    Back_String & "</b></font>"
  
   Exit For
   Else

    cells(myStartRow, myColResult).Value = cells(myStartRow, myColData).Value

    'If there is no colored font in the cell, do nothing to the string but
    'simply copy the cell value to the cell results

  End If
 
 Next i

Next myStartRow

End Sub