Extract data from multiple sheet into one with conditions

Copper Contributor

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

4 Replies

@TheCarb1 

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.

 

 

 

@Subodh_Tiwari_sktneer 

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!

@TheCarb1 

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.

 

 

@Subodh_Tiwari_sktneer 

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.