Adding characters in a cell with various fonts

[jsvanpel]

Guys / Gals,
Thanks your time & assistance:

My group is putting "marks" in Excel (2007) work papers & sometimes they may want to add additional marks to those previously added in a selected cell. What I have below actually works, but I just got my VBA book last week & there has to be a better way.
Specifically, I've saved the "target" off in the same worksheet (That can't be good.) and delete it when I'm done writing it back. Can I save the original characters virtually, or to the personal.xlsb. Is there another approach entirely that you can suggest?
Any guidance for a newbie would be greatly appreciated.

Sub addMarkInCELL()
'
Dim charCount As Integer
Dim charStart As Integer
Dim rngTarget As String
charCount = ActiveCell.Characters.Count
rngTarget = ActiveCell.Address
Application.ScreenUpdating = False
If charCount > 0 Then
    
    Selection.Copy
    Range("dvp99999").PasteSpecial xlPasteAll
    Range(rngTarget).Select
    Range(rngTarget).Clear
        
    For charStart = 1 To charCount
        ActiveCell.Characters(Start:=charStart, Length:=1).Text = ActiveSheet.Range("$dvp$99999").Characters(Start:=charStart, Length:=1).Text
        ActiveCell.Characters(Start:=charStart, Length:=1).Font.Name = ActiveSheet.Range("$dvp$99999").Characters(Start:=charStart, Length:=1).Font.Name
        ActiveCell.Characters(Start:=charStart, Length:=1).Font.FontStyle = ActiveSheet.Range("$dvp$99999").Characters(Start:=charStart, Length:=1).Font.FontStyle
        ActiveCell.Characters(Start:=charStart, Length:=1).Font.Size = ActiveSheet.Range("$dvp$99999").Characters(Start:=charStart, Length:=1).Font.Size
        ActiveCell.Characters(Start:=charStart, Length:=1).Font.Color = ActiveSheet.Range("$dvp$99999").Characters(Start:=charStart, Length:=1).Font.Color
    Next charStart
End If
    ActiveCell.Characters(Start:=charStart, Length:=1).Text = "&"
    ActiveCell.Characters(Start:=charStart, Length:=1).Font.Name = "Wingdings 2"
    ActiveCell.Characters(Start:=charStart, Length:=1).Font.FontStyle = "Bold"
    ActiveCell.Characters(Start:=charStart, Length:=1).Font.Size = 14
    ActiveCell.Characters(Start:=charStart, Length:=1).Font.Color = -4165632
    Range("$dvp$99999").Clear
    Application.ScreenUpdating = True
    
End Sub

 

[István Hirsch]

I do not fully understand the task but if it comes to inserting new characters (as substrings) in excel cells and format them in a single step in a whole range of cells, see:
<o></o>
http://excelfindandformat.herobo.com
or
http://www.youtube.com/user/valfor221

 

[jsvanpel]

Thanks Istvan,
I'll keep working on it.

"Give a man a fish, and you feed him for a day; show him how to catch fish, and you feed him for a lifetime."