Sep 23 2019 02:45 PM
I work as a teacher and I have a cumulative timetable with all subjects, a single sheet for each class. So, for each class I have each day of the year with the relative timetable (there are several changes from week to week).
I'd like to extract my complete timetable to have it in a single sheet and be able to see quickly where I have a lesson. How can I do it?
You can see an example of the file in the attached.
Thanks for your help
Sep 23 2019 08:59 PM
Please find the attached with a code called GetTimeTableSummary on Module1. There is also a Class Module named clsTimeTable with some public variables.
If you have to implement the codes to your original workbook, you will be required to copy both the Module1 and clsTimeTable codes to your workbook.
The codes assume that in your file, the name of all the Class Sheets starts from CLASS and will create a Summary Tab with all the data from the CLASS Sheets sorted by Date and Start Time.
You will also find a button called Create Summary on CLASS 1 Sheet, you may click this button to run the code.
You may also run the code by pressing a shortcut key Ctrl+Shift+R to create the Summary.
Sub GetTimeTableSummary()
Dim ws As Worksheet
Dim wsSummary As Worksheet
Dim tb As clsTimeTable
Dim x As Variant
Dim Coll As New Collection
Dim i As Long
Dim j As Long
Dim r As Long
Dim strTime As String
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "CLASS*" Then
x = ws.Range("A1").CurrentRegion.Value
For i = 2 To UBound(x, 1)
For j = 4 To UBound(x, 2)
If x(i, j) <> "" Then
strTime = x(1, j)
Set tb = New clsTimeTable
tb.Period_Date = x(i, 1)
tb.Period_Day = x(i, 2)
tb.period_Hours = x(i, 3)
tb.StartTime = Replace(Split(strTime, "-")(0), ".", ":")
tb.EndTime = Replace(Split(strTime, "-")(1), ".", ":")
tb.Subject = x(i, j)
tb.ClassName = ws.Name
Coll.Add tb
End If
Next j
Next i
End If
Next ws
On Error Resume Next
Set wsSummary = Worksheets("Summary")
wsSummary.Cells.Clear
On Error GoTo 0
If wsSummary Is Nothing Then
Set wsSummary = Worksheets.Add(before:=Worksheets(1))
wsSummary.Name = "Summary"
End If
wsSummary.Range("A1:G1").Value = Array("Date", "Day", "Start Time", "End Time", "Hours", "Subject", "Class")
r = 2
For i = 1 To Coll.Count
Set tb = Coll(i)
wsSummary.Cells(r, 1) = tb.Period_Date
wsSummary.Cells(r, 2) = tb.Period_Day
wsSummary.Cells(r, 3) = tb.StartTime
wsSummary.Cells(r, 4) = tb.EndTime
wsSummary.Cells(r, 5) = tb.period_Hours
wsSummary.Cells(r, 6) = tb.Subject
wsSummary.Cells(r, 7) = tb.ClassName
r = r + 1
Next i
With wsSummary
.Range("A1").CurrentRegion.Sort key1:=wsSummary.Range("A2"), order1:=xlAscending, key2:=wsSummary.Range("C2"), order2:=xlAscending, Header:=xlYes
With .Range("A1").CurrentRegion
.Offset(1).FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($A2<>"""",MOD(SUM(--(FREQUENCY($A$2:$A2,$A$2:$A2)>0)),2)=1)"
.Offset(1).FormatConditions(1).Interior.Color = RGB(242, 242, 242)
.Offset(1).FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($A2<>"""",MOD(SUM(--(FREQUENCY($A$2:$A2,$A$2:$A2)>0)),2)=0)"
.Offset(1).FormatConditions(2).Interior.Color = RGB(221, 235, 247)
.Borders.Color = vbBlack
.AutoFilter
End With
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit
.Select
End With
Application.ScreenUpdating = True
End Sub
Let me know if this is what you were trying to achieve.
Sep 24 2019 12:08 AM - edited Sep 24 2019 12:09 AM
Thanks a lot for your quick reply.
I copied data on the sheet you made to be sure everything worked but I got "Runtime error: 5" on
.Offset(1).FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($A2<>"""",MOD(SUM(--(FREQUENCY($A$2:$A2,$A$2:$A2)>0)),2)=1)"
What I'd really want to achive is to be able to extract timetables for each subject.
I.E. if I'm the French teacher, I'd like to be able to see, for each class obviously, when I have my lesson: in this way I can have a single sheet with all French lessons and be able to know when and where the lessons are. In this way, every teacher could do it... I don't know if I explained well what's my goal.
Thanks a lot for your help!
Sep 24 2019 01:06 AM
Okay, I have changed the approach.
Now I have inserted a Sheet called "Subject List" with the list of Subjects which appears on your CLASS Sheets and you should do the same as well. Make sure the Subjects listed in Subject List Sheet exactly match with the Subjects on CLASS Sheets.
I have placed a Worksheet_BeforeDoubleClick Event Code on Subject List Sheet Module so that once you have a list of Subjects in Column A on Subject List Tab, you may double click on any Subject and the Summary Sheet for all the records which belong to that Subject would appear.
To test the code, go to Subject List Sheet and double click in any cell with a Subject in Column A.
Let me know if that works for you.
Sep 24 2019 06:34 AM - edited Sep 24 2019 06:38 AM
Sep 24 2019 06:34 AM - edited Sep 24 2019 06:38 AM
The easiest way is to use Power Query. I have attached the file you have provided. When you check it you will see two tables Schedule_1 and Schedule_2. this is important as if you need to add new data you need to insert a new table with a name starting with Schedule. And when you refres the query you wil have all the data in the table. then you can easily filter it from the final table. or you can filter it in the query.
Note: I have used Excel 2016 for this so if you have a newer version, you should have no problem with it. İf you have Excel 2010 or 2013 you need to install power query. İt is free and can be downloaded from Microsoft site.