Private Sub Worksheet_Change(ByVal Target As Range)
Dim k&, j&,x%, cel$
If Not Intersect(Target, Range("B7:K" & Range("A65536").End(xlUp).Row)) Is Nothing Then
For j = 12 To 24
cel = cel & Cells(Target.Row, j).Value
Next j
With Cells(Target.Row, 1)
.Font.ColorIndex = 1
.Value = cel
End With
End If
j = 1
For k = 12 To 14
If Not Cells(Target.Row, k).Value = "" Then
Cells(Target.Row, 1).Characters(Start:=j, Length:=1).Font.ColorIndex = 10 + k
x = x + 3
End If
j = j + 3
Next k
j = 1
For k = 15 To 22
If Not Cells(Target.Row, k).Value = "" Then
Cells(Target.Row, 1).Characters(Start:=j + x, Length:=1).Font.ColorIndex = 25 + k
j = j + 4
End If
Next k
If Not Cells(Target.Row, 24).Value = "" Then Cells(Target.Row, 1).Characters(Start:=InStr(1, Cells(Target.Row, 1), "/") - 2, Length:=1).Font.ColorIndex = 45
End Sub