Read cell content & ADD content + font properties *SOLVE

[APOC [T.I.M.]]

I use this to read cell content, add some text/characters (ie. [ and ]) and change the properties of the complete cell

Sub COMMENT()
Worksheets("DVD Lijssie").Activate
 If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "]" & " " & "["
    With ActiveCell.Font
        .Name = "Arial Narrow"
        .Size = 8
        .ColorIndex = 16
    End With
End If
End Sub

HOW can I change this vba-code so it leave's the content of the cell like it is and add some content with the use of let's say TexBox1 and ONLY use different font properties for the newely added content?

With kind regards, Tim

 

[Andrew Poulsom]

Check out the Characters property of the Range object. Example:

Sub Test()
    With Worksheets("Sheet1").Range("A1")
        .Value = .Value & "abc"
        .Characters(Len(.Value) - Len("abc") + 1, Len("abc")).Font.Bold = True
    End With
End Sub

 

[APOC [T.I.M.]]

Can't quite follow this one, and like this nothing happens?

 

[Andrew Poulsom]

What don't you follow? Enter something in A1 on Sheet1 and run the macro. It adds "abc" to the end of what's there and makes it bold.

 

[APOC [T.I.M.]]

OoOoOoPs

Oowh darn, SORRY!
Overlooked that it's doing stuff @ A1, I was looking at the wrong place.
I thought it replaced @ the place where my cursor/selection was, my bad... (.Range("A1") *thuh* stupid me)
GREAT, thank you very much, it's allmost perfect.

I'd like it to work somehow like this:

Sub Test()
Worksheets("DVD Lijssie").Activate
If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    ActiveCell.FormulaR1C1 = "[" & ActiveCell.Value & "]"
    With ActiveCell.Font
        .Name = "Arial Narrow"
        .Size = 8
        .ColorIndex = 16
    End With
End If
End Sub

This seems to work:

Sub Test()
If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    With Worksheets("DVD Lijssie").Activate
        ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "[" & "abc" & "]"
        ActiveCell.Characters(Len(ActiveCell.Value) - Len("[abc]") + 1, Len("[abc]")).Font.ColorIndex = 16
        'ActiveCell.Characters(Len(ActiveCell.Value) - Len("abc") + 1, Len("abc")).Font.Bold = True
    End With
End If
End Sub

But how come that when I run this macro twice (or what ever) on the same cell,
that it removes the bold from the previous "abc" and add's a new "abc" in bold (as expected)?
I don't quite understand why the previous "abc" gets reset or what ever.

How can I add more font properties instead of only bold? I'd like to add fontsize and color too...
How could I get the value/content as entered in CheckBox1 (used in UserForm1) placed in this macro instead of the predifined "abc"? (so in between the brackets)

with kind regards, Tim

 

[APOC [T.I.M.]]

Read TextBox1 (used in UserForm1) & Write in ActiveCell

This is what I use at the moment (more/extra predefined font settings):

Sub Test()
If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    With Worksheets("DVD Lijssie").Activate
        ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "[" & "abc" & "]"
        With ActiveCell.Characters(Len(ActiveCell.Value) - Len("[abc]") + 1, Len("[abc]")).Font
        .Name = "Arial Narrow"
        .FontStyle = "Regular"
        .Size = 8
        .ColorIndex = 16
        End With
    End With
End If
End Sub

But why is it that when I run this macro twice (or what ever) on the same cell,
that it removes the bold from the previous "abc" and add's a new "abc" in bold (the last part is as expected of course)?
I don't quite understand why the previous "abc" gets reset (changed back?), or what ever.

How could I get the value/content as entered in TextBox1 (used in UserForm1) placed in this macro instead of the predefined "abc" ???
(Read TextBox1 (used in UserForm1) & Write in ActiveCell using this Macro)

with kind regards, Tim

 

[Vak410]

My guess is that it has got something to do with the code, like when it searches for characters it strips the "richtext" (font properties)... I am not sure but it seems to me it does something like that.

 

[APOC [T.I.M.]]

Re: Read TextBox1 (used in UserForm1) & Write in ActiveC

I use this vba in/for my UserForm:

Private Sub UserForm_Activate()
CheckBox_ADD = False
CheckBox_Change.Value = True
CheckBox_Cleanup = False
'TextBox_ADD_Line
End Sub

Private Sub OK_Button_Form_Ctrl_W_Click()

If CheckBox_ADD.Value = True And CheckBox_Change.Value = False And CheckBox_Cleanup.Value = False Then
    TextBox_ADD_Line.SetFocus
        If TextBox_ADD_Line.Value = Empty Then
            ' Cancel = True
            MsgBox "Enter a value"
        Else
            MsgBox "ADD Cell Content with input", vbOKOnly + vbInformation, "TEST (ADD)"
            
If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    With Worksheets("DVD Lijssie").Activate
        ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "[" & "TextBox_ADD_Line.Value" & "]"
        With ActiveCell.Characters(Len(ActiveCell.Value) - Len("[TextBox_ADD_Line.Value]") + 1, Len("[TextBox_ADD_Line.Value]")).Font
        .Name = "Arial Narrow"
        .FontStyle = "Regular"
        .Size = 8
        .ColorIndex = 16
        End With
    End With
End If
            
            Unload Me
        End If
 Else
 ' NIKS
End If

If CheckBox_Change.Value = True And CheckBox_ADD.Value = False And CheckBox_Cleanup.Value = False Then
    MsgBox "CHANGE Cell Content with input", vbOKOnly + vbInformation, "TEST (CHANGE)"
Worksheets("DVD Lijssie").Activate
 If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "]" & " " & "["
    With ActiveCell.Font
        .Name = "Arial Narrow"
        .Size = 8
        .ColorIndex = 16
    End With
End If

    Unload Me
 Else
 ' NIKS
End If

If CheckBox_Cleanup.Value = True And CheckBox_ADD.Value = False And CheckBox_Change.Value = False Then
    MsgBox "CLEAN Cell Content with input", vbOKOnly + vbInformation, "TEST (CLEAN)"
    Unload Me
 Else
 ' NIKS
End If

If CheckBox_Cleanup.Value = True And CheckBox_ADD.Value = False And CheckBox_Change.Value = True Then
    MsgBox "CLEAN & CHANGE Cell Content with input", vbOKOnly + vbInformation, "TEST (CLEAN & CHANGE)"
    Unload Me
 Else
 ' NIKS
End If

If CheckBox_ADD.Value = True And CheckBox_Change.Value = True And CheckBox_Cleanup.Value = True Then
    TextBox_ADD_Line.SetFocus
        If TextBox_ADD_Line.Value = Empty Then
            ' Cancel = True
            MsgBox "Enter a value"
        Else
            MsgBox "ADD, CHANGE & CLEAN Cell Content with input", vbOKOnly + vbInformation, "TEST (ADD, CHANGE & CLEAN)"
            Unload Me
        End If
 Else
 ' NIKS
End If

If CheckBox_ADD.Value = True And CheckBox_Change.Value = True And CheckBox_Cleanup.Value = False Then
    TextBox_ADD_Line.SetFocus
        If TextBox_ADD_Line.Value = Empty Then
            ' Cancel = True
            MsgBox "Enter a value"
        Else
            MsgBox "ADD & CHANGE Cell Content with input", vbOKOnly + vbInformation, "TEST (ADD, CHANGE)"
            Unload Me
        End If
 Else
 ' NIKS
End If

If CheckBox_ADD.Value = True And CheckBox_Change.Value = False And CheckBox_Cleanup.Value = True Then
    TextBox_ADD_Line.SetFocus
        If TextBox_ADD_Line.Value = Empty Then
            ' Cancel = True
            MsgBox "Enter a value"
        Else
            MsgBox "ADD & CLEAN Cell Content with input", vbOKOnly + vbInformation, "TEST (ADD & CLEAN)"
            Unload Me
        End If
 Else
 ' NIKS
End If


'Skip:
'Unload Me
End Sub

How could I get the value/content as entered in TextBox1 (used in UserForm1) placed in this macro instead of the predefined "abc" ???
(Read TextBox1 (used in UserForm1) & Write in ActiveCell using this Macro)
,,Just'' changing abc into TextBox_ADD_Line.Value won't pull the trick, instead of using the content as entered in this TextBox it just adds the line TextBox_ADD_Line.Value into the Cell, bummer...
edit:
Changed it into this and it seems to work pretty fine:

If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
    With Worksheets("DVD Lijssie").Activate
        ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "[" & TextBox_ADD_Line.Value & "]"
        With ActiveCell.Characters(Len(ActiveCell.Value) - Len("[" & TextBox_ADD_Line.Value & "]") + 1, Len("[" & TextBox_ADD_Line.Value & "]")).Font
        .Name = "Arial Narrow"
        .FontStyle = "Regular"
        .Size = 8
        .ColorIndex = 16
        End With
    End With
End If

STILL why is it that when I run this macro twice (or what ever) on the same cell, that it removes the font properties from the previous "abc"
And THEN it add's a new "abc" and with the font properties set => That last part (add new & with the font properties set) is as expected of course...
I don't quite understand why the previous "abc" gets reset (changed back?), or what ever.

with kind regards, Tim.

 

[Andrew Poulsom]

Resetting the Value or FormulaR1C1 overwrites what's there and therfore removes any existing rich text formatting. Adding to the text using the Insert method of the Characters object seems to work. Example:

Sub Test()
    Const NewText As String = "abc"
    With Worksheets("Sheet1").Range("A1")
        .Characters(Len(.Value) + 1).Insert NewText
        .Characters(Len(.Value) - Len(NewText) + 1, Len(NewText)).Font.Bold = True
    End With
End Sub

 

[APOC [T.I.M.]]

so close but no sigar (at the moment)

Yes! that works pretty fine, but now I can't use it anymore in my UserForm, AT LEAST not like this:

Private Sub OK_Button_Form_Ctrl_W_Click()

If CheckBox_ADD.Value = True And CheckBox_Change.Value = False And CheckBox_Cleanup.Value = False Then
    TextBox_ADD_Line.SetFocus
        If TextBox_ADD_Line.Value = Empty Then
            ' Cancel = True
            MsgBox "Enter a value"
        Else
        ' MsgBox "ADD input to Cell-Content", vbOKOnly + vbInformation, "ADD input to Cell-Content"
'        With Worksheets("DVD Lijssie").Activate
'            If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
'                ActiveCell.FormulaR1C1 = ActiveCell.Value & " " & "[" & TextBox_ADD_Line.Value & "]"
'                    With ActiveCell.Characters(Len(ActiveCell.Value) - Len("[" & TextBox_ADD_Line.Value & "]") + 1, Len("[" & TextBox_ADD_Line.Value & "]")).Font
'                        .Name = "Arial Narrow"
'                        .FontStyle = "Regular"
'                        .Size = 8
'                        .ColorIndex = 16
'                    End With
'            End If
'        End With

        Const NewText As String = ActiveCell.Value & " " & "[" & TextBox_ADD_Line.Value & "]"
            With Worksheets("DVD Lijssie").Activate
                If ActiveCell.Value <> 0 Then ' Change all in to ... ... ...
                    ActiveCell.Characters(Len(ActiveCell.Value) + 1).Insert NewText
                    With ActiveCell.Characters(Len(ActiveCell.Value) - Len(NewText) + 1, Len(NewText)).Font
                        .Name = "Arial Narrow"
                        .FontStyle = "Regular"
                        .Size = 8
                        .ColorIndex = 16
                    End With
                End If
            End With

        Unload Me
        End If
 Else
 ' NIKS / Nothing! / Just Continue...
End If

'Skip:
'Unload Me
End Sub

This returns: Expression for constant required
The previous version, within comments in this example-code did work wel, except the Resetting Value for FormulaR1C1 problem.
I'd like the code to read the TextBox (TextBox_ADD_Line) on what to ADD instead of abc.
The problem with my adjustification on your latest code seems to me with Const and Private Sub OK_Button_Form_Ctrl_W_Click().
(All of this is done in the UserForm1 vba sourcecode)