VBA / Formula to apply rich text formatting to multiple parts of one cell

[Carkcark]

In the attached I have provided a sample of data as an example of 3 columns of Date, Activity, and Location. In the real spreadsheet there are approximately 300 rows of data. The goal is to have it so that the 3 columns are concatenated and then the Date portion is made bold, the Activity portion is kept normal, and the Location is made bold and coloured either green or orange depending on whether the word in the location column says gym or not.

Is there a way to achieve this with a formula or some VBA? If so how would I go about this?

 

[RobP]

Hi, the only way I could think of doing it would be to first "Conditional Format" the raw data cells (eg. you can quickly colour the cells in column C by selecting them all, and color Green if cell value contains "Gym". Equally you can Bold all the dates in Column A in one hit.

Then just use a concatenate formula : =CONCAT(A11," - ",B11," - ",C11)

Rgds
Rob

 

[mikerickson]

Cells that have formulas cannot have rich text. If a cell has a formula all the characters will have the same format.

For a VB solution, you could put code like this in the sheet's code module

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDate As Range, rngActivity As Range, rngLocation As Range
    Dim rngInput As Range, rngOutput  As Range
    Dim strDate As String, strActivity As String, strLocation As String
    Dim oneCell As Range
    
    Const Delimiter As String = ","
    Set rngDate = Me.Range("A:A")
    Set rngActivity = Me.Range("B:B")
    Set rngLocation = Me.Range("C:C")
    Set rngOutput = Me.Range("D:D")
    
    Set rngInput = Application.Union(rngDate, rngActivity, rngLocation)
    
    If Not Application.Intersect(Target, rngInput) Is Nothing Then
        For Each oneCell In Application.Intersect(Target, rngInput)
            With oneCell
                strDate = .EntireRow.Cells(1, rngDate.Column).Text
                strActivity = .EntireRow.Cells(1, rngActivity.Column).Text
                strLocation = .EntireRow.Cells(1, rngLocation.Column).Text
                
                With .EntireRow.Cells(1, rngOutput.Column)
                    .Font.Bold = False
                    .Font.Color = .Characters(1, 1).Font.Color
                    .Value = strDate & Delimiter & strActivity & Delimiter & strLocation
             
                    .Characters(1, Len(strDate)).Font.Bold = True
        
                    With .Characters(1 + Len(strDate) + Len(strActivity) + 2 * Len(Delimiter), Len(strLocation))
                        .Font.Bold = True
                        .Font.Color = IIf(LCase(strLocation) = "gym", vbGreen, RGB(255, 192, 0))
                    End With

                End With
            End With
        Next oneCell
    End If
End Sub