Macro to Compute Info if Cell is Red

I have a spreadsheet (Attached) that tracks a schedule of when certain games are being played each day. I am wondering if there is a way that the open spots (highlighted in Red) could be computed into a sheet that will show me the day and time of all the open "red" cells. So for example in that attached file, the Sunday open times would compute into: Sunday, Jan. 22: 8pm, 10pm, 11pm and so forth.
Any help or direction would be appreciated.
Thanks

Nathan

You will need to create a second sheet. Leave it blank but title it Schedule. I am assuming that the format you provided will be the same all the time. If not this will fail on others.

Sub Schedule()
Dim ws1 As Worksheet:   Set ws1 = Sheets(1)
Dim ws2 As Worksheet:   Set ws2 = Sheets("Schedule")
Dim lastrow As Long, icell As Long, LR As Long
Dim rCell As Range, myRange As Range

ws2.Cells.ClearContents
ws2.Cells.ClearFormats

lastrow = ws1.Range("B" & Rows.Count).End(xlUp).Row
 
For icell = 2 To lastrow - 7 Step 9
    Set myRange = ws1.Range("B" & icell, "G" & icell + 7)
    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws1.Range("E" & icell).Value
    LR = ws2.Range("A" & Rows.Count).End(xlUp).Row
        For Each rCell In myRange
            If rCell.Interior.ColorIndex = 3 Then
                ws2.Range("DD" & LR).End(xlToLeft).Offset(0, 1).Value = ws1.Range("B" & rCell.Row).Value
            End If
        Next rCell
Next icell

End Sub

Thank you for your help, this is exactly what I need.
I generally have between 3-8 sheets that I would need to compute. How difficult would it be to adjust the code to allow multiple sheets to compile on the "schedule" sheet?
Thanks again!

This should do it for you. With this new code you won't need to create a "Schedule" Sheet. It will do it for you.

Sub Schedule()
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Schedule"
Dim ws2 As Worksheet:   Set ws2 = Sheets("Schedule")
Dim lastrow As Long, icell As Long, LR As Long, wksht As Long
Dim rCell As Range, myRange As Range

For wksht = 1 To Worksheets.Count - 1
    lastrow = Sheets(wksht).Range("B" & Rows.Count).End(xlUp).Row
    
For icell = 2 To lastrow - 7 Step 9
    Set myRange = Sheets(wksht).Range("B" & icell, "G" & icell + 7)
    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets(wksht).Range("E" & icell).Value
    LR = ws2.Range("A" & Rows.Count).End(xlUp).Row
        For Each rCell In myRange
            If rCell.Interior.ColorIndex = 3 Then
                ws2.Range("DD" & LR).End(xlToLeft).Offset(0, 1).Value = Sheets(wksht).Range("B" & rCell.Row).Value
            End If
        Next rCell
Next icell

Next wksht
End Sub

Perfect. Works exactly like I need it to! I greatly appreciate your help!

I have a spreadsheet (Attached - SampleSheet1) that tracks a schedule of when certain games are being played each day. The open spots (highlighted in Red) are computed into a sheet that will show me the day and time of all the open "red" cells. So for example in that attached file, the Sunday open times would compute into: Sunday, Jan. 22: 8pm, 10pm, 11pm and so forth.

I have changed the format of my spreadsheet (also attached - SampelSheet2) and need help updating the code to allow it to continue to do what it does. Can anyone take a quick look and help me make the appropriate adjustments to the code?
Thanks

Nathan