09-23-2019 02:45 PM
09-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
09-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.
09-24-2019 12:08 AM - edited 09-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!
09-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.
09-24-2019 06:34 AM - edited 09-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.