You can try running this macro on your data sheet:
Sub a()
Dim ws As Worksheet, i As Long, j As Long, c As Long, cf As Long
Application.ScreenUpdating = False
Set ws = ActiveSheet
With Sheets.Add
ws.Range("A1:D2").Copy .Cells(1)
For i = 3 To ws.Cells(rows.count, 1).End(xlUp).row
c = 4
With .Cells(rows.count, 1).End(xlUp).Offset(1)
ws.Cells(i, 1).Resize(, 4).Copy .Cells(1)
For j = 5 To ws.Cells(1, Columns.count).End(xlToLeft).Column Step 2
If ws.Cells(i, j).Value <> "" Then
cf = 0
Select Case ws.Cells(i, j).Value 'your conditional formatting
Case "G": cf = 1
Case "A": cf = 2
Case "R": cf = 3
End Select
.Offset(, c).Font.ColorIndex = ws.Cells(i, j).FormatConditions(cf).Font.ColorIndex
.Offset(, c).Interior.ColorIndex = ws.Cells(i, j).FormatConditions(cf).Interior.ColorIndex
.Offset(, c).Value = Split(ws.Cells(1, j).Value, " ")(1) & ", " & ws.Cells(2, j).Value
c = c + 1
End If
Next
End With
Next
For j = 5 To .UsedRange.Columns.count
.Cells(1, j).Value = "Subject " & j - 4
Next
.Cells.EntireColumn.AutoFit
End With
Set ws = Nothing
Application.ScreenUpdating = True
End Sub
Bookmarks