Add text in Excel Cell using macro and colour the entry-CodePudding

I'm trying to create a customer log entry file in excel. For same customer, I have to add multiple entries in the same cell in a new line with current date and colour the entry. Majority of the entries are the same like Entry time and comments, break out with comments etc. I want to create buttons for each entry and keep a colour for it, so when I press the button it creates a new entry in the same cell with colour. I have manage to put up a code which creates a new entry with todays date in the same cell and colour the text but everytime do a new entry it deletes the colour of the previous entry. I want to maintain the colour of all the entries. Can someone please help me fix up below code to achieve this?

Sub addTextAtEndCellGreen()

    Dim myValue As Variant
    Dim cellCount As Integer
    
    cellCount = ActiveCell.Characters.Count
    
    myValue = InputBox("Give me some input")
    
    If ActiveCell.Value = "" Then
    ActiveCell.Value = Date & " - " & myValue
Else
    
    ActiveCell.Value = ActiveCell.Value & vbNewLine & Date & " - " & myValue
    
End If
    
    
    
    ActiveCell.Characters(cellCount   2).Font.Color = vbGreen
    

End Sub

CodePudding user response：

When running your code step by step with F8, running this line ActiveCell.Value = ActiveCell.Value & vbNewLine & Date & " - " & myValue, makes the whole value in the cell suddenly change to the same color (even if it was green and blue before). It is quite strange that VBA behaves that way, as you are specifically asking to change only the value.

It would thus be needed to store all the different colors of the text somewhere, and then apply them again after the cell value was updated, which seems quite cumbersome. If possible to rather have the text added in different cells, it would be easier to handle colors.

Storing the colors doesn't always work:

Sub addTextAtEnCellGreen()

    Dim myValue As Variant
    Dim cellCount As Integer
    
    cellCount = ActiveCell.Characters.Count
    myValue = InputBox("Give me some input")
    
    'Store colors
    Dim listColor() As Variant
    string_list = "Colors stored in listColor: "
    ReDim listColor(cellCount   1)
    For i = 1 To cellCount
        listColor(i) = ActiveCell.Characters(i, 1).Font.Color
        string_list = string_list & " " & listColor(i)
    Next i
    'MsgBox (string_list)  'Just for the debug
    
    If ActiveCell.Value = "" Then
        ActiveCell = Date & " - " & myValue
    Else
        ActiveCell = ActiveCell.Value & vbNewLine & Date & " - " & myValue  'vbNewLine &
    End If
    
    'Put back stored colors on text
    For i = 1 To cellCount
         ActiveCell.Characters(i, 1).Font.Color = listColor(i)
    Next i
    'First argument of .Characters: start, then length
    ActiveCell.Characters(cellCount   1, ActiveCell.Characters.Count - cellCount   1).Font.Color = vbGreen

End Sub