Identify column header name based on a colored cell

[Kartyk]

Hi All,

A code to identify the colorindex = 10, across a row. Identify all those cells and list the Corresponding column header in a single cell split by a comma or a semi colon

Cheers
K

[p45cal]

examples of formula in cell:
=greens(A3:M3)
or:
=greens(3:3)

Function greens(TheRange)
'Application.Volatile
For Each cll In TheRange.Cells
If cll.Interior.ColorIndex = 10 Then myresult = myresult & "," & Split(cll.Address, "$")(1)
Next cll
greens = Mid(myresult, 2)
End Function
If the colours change then you need to recalculate the sheet (or change a value in one of the cells that the formula is looking at).

[Kartyk]

Thanks for your response, however, I may not have been clear with my request. Heres one with the example in the attached file.

If you refer to the file, wherever there is a color coded cell, the column header name is listed under comments column. This is what I would like to achieve with the code.

Cheers
K17921

[p45cal]

Function greens(TheRange, Headers)
'Application.Volatile
Counter = 0
For Each cll In TheRange.Cells
Counter = Counter + 1
If cll.Interior.ColorIndex = 10 Then myresult = myresult & "," & Headers.Cells(Counter)
Next cll
greens = Mid(myresult, 2)
End Function

[Kartyk]

Thankx P45cal, however, a code not as a function possible ? I would like to incorporate it into bigger code. Also, population is huge and i do not want things done manually.

cheers

[p45cal]

You can use the function in code too. In your file (assuming you've got cells with interior.colorindex=10 instead of red) these 3 subs will each do just the same as the formulae on the sheet did:
Sub test()
With Sheets("Sheet1")
For Each rw In .Range("B2:E6").Rows
rw.Cells(1).Offset(, -1).Value = greens(rw, .Range("B1:E1"))
Next rw
End With
End Sub

Sub test2()
With Sheets("Sheet1")
For Each cll In .Range("A2:A6").Cells
cll.Value = greens(cll.Offset(, 1).Resize(, 4), .Range("B1:E1"))
Next cll
End With
End Sub

Sub test3()
With Sheets("Sheet1").Range("A2:A6")
.FormulaR1C1 = "=greens(RC[1]:RC[4],R1C2:R1C5)"
.Value = .Value
End With
End Sub

[Kartyk]

Thanx a lot !!! works like a charm.

Cheers