Append text to a cell keeping text formatting

[d365b]

Hi everyone!

I hope you are well. Is there a way to append text from a TextBox on a UserForm to a cell without losing the cell text formatting? Please see sample workbook attached

TextBoxSample

 

[Anthony47]

You have to reformat the output value according the starting string, thus you have first to read and save the initial formatting of the characters and then reuse those parametres to format the output.
For example the following Sub CommandButton1_Click will work on the "activecell", save its formats, modify the cell, reformat it:

Private Sub CommandButton1_Click()
Dim BaseR As Range, fArr(), I As Long, OffLen As Long
'
Set BaseR = ActiveCell
ReDim fArr(1 To Len(BaseR.Value), 1 To 2)     '<<Increase size to store more formatting elements
For I = 1 To Len(BaseR)
    fArr(I, 1) = BaseR.Characters(I, 1).Font.Color
    fArr(I, 2) = BaseR.Characters(I, 1).Font.Bold
Next I
'
BaseR.Value = "******* " & Format(Date, "dd/mm/yy", 2, 3) & " *******" & _
   vbLf & TextBox1.Value & vbLf & "******* OLD TEXT *******" & _
   vbLf & ActiveSheet.Range("J10").Value
OffLen = Len(BaseR.Value) - UBound(fArr)
'Final reformatting:
For I = 1 To UBound(fArr)
    BaseR.Characters(OffLen + I, 1).Font.Color = fArr(I, 1)
    BaseR.Characters(OffLen + I, 1).Font.Bold = fArr(I, 2)
Next I
    Unload Me
End Sub

Be aware that I saved only Color and Bold, but formatting includes much more options; if you wish to consider more options then you have to increase the "width" fo fArr (see instruction marked <<) the save each of them into fArr. And then you have to extend the "final reformatting" phase to restore each of the parametre

Of course you need to adapt the concept to your "append text" approach
Bye

 

[d365b]

You have to reformat the output value according the starting string, thus you have first to read and save the initial formatting of the characters and then reuse those parametres to format the output.
For example the following Sub CommandButton1_Click will work on the "activecell", save its formats, modify the cell, reformat it:

Private Sub CommandButton1_Click()
Dim BaseR As Range, fArr(), I As Long, OffLen As Long
'
Set BaseR = ActiveCell
ReDim fArr(1 To Len(BaseR.Value), 1 To 2)     '<<Increase size to store more formatting elements
For I = 1 To Len(BaseR)
    fArr(I, 1) = BaseR.Characters(I, 1).Font.Color
    fArr(I, 2) = BaseR.Characters(I, 1).Font.Bold
Next I
'
BaseR.Value = "******* " & Format(Date, "dd/mm/yy", 2, 3) & " *******" & _
   vbLf & TextBox1.Value & vbLf & "******* OLD TEXT *******" & _
   vbLf & ActiveSheet.Range("J10").Value
OffLen = Len(BaseR.Value) - UBound(fArr)
'Final reformatting:
For I = 1 To UBound(fArr)
    BaseR.Characters(OffLen + I, 1).Font.Color = fArr(I, 1)
    BaseR.Characters(OffLen + I, 1).Font.Bold = fArr(I, 2)
Next I
    Unload Me
End Sub

Be aware that I saved only Color and Bold, but formatting includes much more options; if you wish to consider more options then you have to increase the "width" fo fArr (see instruction marked <<) the save each of them into fArr. And then you have to extend the "final reformatting" phase to restore each of the parametre

Of course you need to adapt the concept to your "append text" approach
Bye

Brilliant Anthony! I guess I cannot apply this approach if I wish to display the “OLD TEXT” (whatever is in the ActiveCell) in the TextBox as displayed on the sheet, am I right?

 

[Anthony47]

Userfor textbox don't support text formatting.
You could go through a process of creating an image of the cell, display the image in an Image control, edit via the TextBox as now; but is it justified?

Bye

 

[d365b]

Userfor textbox don't support text formatting.
You could go through a process of creating an image of the cell, display the image in an Image control, edit via the TextBox as now; but is it justified?

Bye

Not really, too much effort. Many thanks though for your tips