CODEWITHSUNDEEP
excelvbaexcel-formula
Omar Gonzales
Omar Gonzales

Reputation: 4008

Format text color based on background color of other cell

I'm trying to make things easier for other people using an Excel file.

I need to color the concatenated result according to what color is in the original cells.

For example, as in the original cells cells have colors, in the concatenated result it should also apply: pe should be gray, pd blue, email orange... and so on... But in the concatenate string below all text is black.

Is this possible?

The goal is to make it easier to tell from which cell comes the each part of the concatenated result.

enter image description here

enter image description here

Edit 1: Yes, formula is in H7.

enter image description here

However, running that code does not show any result?

enter image description here

enter image description here

Edit 2:

So code, creates a copy of concataned string, but still missing the colors.

enter image description here

Upvotes: 0

Views: 141

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, test the next solution. It uses Worksheet_Change event and assumes that the formula is in "H7" (looking to the pictore you show...). When any of cells in the range "H5:P5" is changed, automatically the formula result is copied below the cell having the formula (in "H8") and string characters are colored as the cells where they have been taken for concatenation.

Please, copy the next code in the sheet code module where the formula exists (right click on the sheet name and choose View Code):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Target, Me.Range("H5:P5")) Is Nothing Then
            Dim aC As Range, rngCol As Range, rngPr As Range, c As Range, strCell As String, startCh As Long
            Set aC = Me.Range("H7")
            Application.EnableEvents = False
                If aC.HasFormula Then
                     Set rngCol = aC.Offset(1)
                     strCell = aC.value: rngCol = strCell
                     Set rngPr = aC.Precedents
                     For Each c In rngPr.cells
                             startCh = InStr(1, strCell, c.value)
                             rngCol.Characters(startCh, Len(c.value)).Font.Color = c.Font.Color
                     Next c
                   End If
            Application.EnableEvents = True
     End If
End Sub

Please, send some feedback after testing it.

I would like to also mention that Precedents are returned only for the used cells in formula **but only the range(s) from the respective worksheet. I mean, if in concatenation are involved ranges from different sheets, they will not be returned in the Precedents range...

Edited:

Please, check the next version, which will color each string according to the cel where it has been taken from, even if it has been processed for the previous cells:

Private Sub Worksheet_Change(ByVal Target As Range)
      Dim rngFormula As Range: Set rngFormula = Me.Range("H5:P5")
      If Not Intersect(Target, rngFormula) Is Nothing Then
            Dim aC As Range, rngCol As Range, rngPr As Range, c As Range, strCell As String, startCh As Long
            Dim firstCh: firstCh = 1 'to start searching after the word has been found!
            ReDim arrUsed(rngFormula.cells.count - 1)
            Set aC = Me.Range("H7")
            Application.EnableEvents = False
                If aC.HasFormula Then
                     Set rngCol = aC.Offset(1)
                     strCell = aC.value: rngCol = strCell
                     Set rngPr = aC.Precedents
                     For Each c In rngPr.cells
                             startCh = InStr(firstCh, strCell, c.value)
                             rngCol.Characters(startCh, Len(c.value)).Font.Color = c.Font.Color
                             firstCh = startCh + Len(c.value)
                     Next c
                   End If
            Application.EnableEvents = True
     End If
End Sub

Upvotes: 1

Related Questions