Two different fonts in one cell using excel vba

Question

In order to put a degree symbol after existing data in a cell, I consequently created a macro button to my ribbon. Also, I wanted to create a button that would add a check mark. Wingdings 2 converts "P" to a checkmark, according to my research. I can't figure out how to add the Wingdings 2 checkmark and keep the font of my current data without changing the font of the entire cell to Wingdings 2.

Sub Add_check()

Dim cellinfo As String
Dim cellinfoplus As String

'Grab existing content
cellinfo = ActiveCell.Value

'Change the "P" to a checkmark
ActiveCell.Value = "P"
    With Selection.Font
        .Name = "Wingdings 2"
    End With
'Save the checkmark into variable
cellinfoplus = ActiveCell.Value

'Concatenate variables
ActiveCell.Value = cellinfo + cellinfoplus

End Sub

I looked through this post on Mr. Excel but couldn't understand how to modify it and the youtube videos were taken down.

Answer 1

Public Sub add_degree_symbol()
   ActiveCell.Value = ActiveCell.Value & "°"
End Sub

Public Sub addCheck()
   With ActiveCell
      .Value = .Value & "P"
      .Characters(Len(.Value), 1).Font.Name = "Wingdings 2"
   End With
End Sub

and a sub for adding any symbols at start or at end (default)

Public Sub addSymbols(Optional addAny As String = "P", Optional atStart As Boolean = False, Optional fontName As String = "Wingdings 2")
   Dim ln As Integer, lnany As Integer

   With ActiveCell
      ln = Len(.Value)
      lnany = Len(addAny)
      If atStart Then
         .Value = addAny & .Value
         .characters(1, lnany).Font.Name = fontName
      Else
         .Value = .Value & addAny
         .characters(Len(.Value), lnany).Font.Name = fontName
      End If
   End With
End Sub

Sub helper()
   Call addSymbols("P ", True)
End Sub

And another version to toggle the symbols

Public Sub toogleSymbols(Optional addAny As String = "P", Optional atStart As Boolean = False, Optional fontName As String = "Wingdings 2")
   Dim ln As Integer, lnany As Integer

   With ActiveCell
      ln = Len(.Value)
      lnany = Len(addAny)
      If atStart Then
         If Mid(.Value, 1, lnany) = addAny Then
            fontName = .Characters(lnany + 1, 1).Font.Name
            .Value = Right(.Value, ln - lnany)
            .Characters(1, ln - lnany).Font.Name = fontName
         Else
            .Value = addAny & .Value
            .Characters(1, lnany).Font.Name = fontName
         End If
      Else
         If Right(.Value, lnany) = addAny Then
            .Value = Left(.Value, ln - lnany)
         Else
            .Value = .Value & addAny
            .Characters(Len(.Value) - 1, lnany).Font.Name = fontName
         End If
      End If
   End With
End Sub

Sub callToogleSymbols()
   Call toogleSymbols("P ", True)
End Sub