Edit VBA code to get data from multiple sheets

Hello everybody
The report indicates the lectures that the student "A" had from multiple sheets by using VBA code.
I want to edit the vba code to include "Shift" ,it can be brought from other sheets from row No. 1
Please your support

This should do it

Sub summary_code()
    Dim ws As Worksheet, myName, a, i As Long, ii As Long, x, w
    With Sheets("Report")
        '.Range("a15").CurrentRegion.Offset(, 1).ClearContents
       .Range("B15", "WWW20").ClearContents
    '.Range("J2", "K6").ClearContents
        myName = .Range("b2").Value
    End With
    ReDim w(1 To 6, 1 To 1)
    w(1, 1) = "Sheet Name": w(2, 1) = "Count": w(3, 1) = "Lecturer": w(4, 1) = "Lectures": w(5, 1) = "Date"
    For Each ws In Worksheets
        If ws.Name <> "Report" Then
            x = Application.Match(myName, ws.Columns(2), 0)
            If IsNumeric(x) Then
                a = ws.Cells(1).CurrentRegion.Value
                For ii = 3 To UBound(a, 2)
                    If a(x, ii) <> "" Then
                        ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
                        w(1, UBound(w, 2)) = ws.Name
                        w(2, UBound(w, 2)) = IIf(w(1, UBound(w, 2) - 1) <> ws.Name, 1, Val(w(2, UBound(w, 2) - 1)) + 1)
                        w(3, UBound(w, 2)) = a(2, ii): w(4, UBound(w, 2)) = a(3, ii): w(5, UBound(w, 2)) = a(x, ii)
                        w(6, UBound(w, 2)) = a(1, ii)
                    End If
                Next
            End If
        End If
    Next
    Sheets("Report").Range("a15").Resize(6, UBound(w, 2)).Value = w
End Sub

Hi leprince

Try this:

Sub summary_code()
    Dim ws As Worksheet, myName, a, i As Long, ii As Long, x, w
    With Sheets("Report")
        '.Range("a15").CurrentRegion.Offset(, 1).ClearContents
       .Range("A15", "WWW20").ClearContents
    '.Range("J2", "K6").ClearContents
        myName = .Range("b2").Value
    End With
    ReDim w(1 To 6, 1 To 1)
    w(1, 1) = "Sheet Name": w(2, 1) = "Count": w(3, 1) = "Lecturer": w(4, 1) = "Lectures"
    w(5, 1) = "Date": w(6, 1) = "Shift"
    For Each ws In Worksheets
        If ws.Name <> "Report" Then
            x = Application.Match(myName, ws.Columns(2), 0)
            If IsNumeric(x) Then
                a = ws.Cells(1).CurrentRegion.Value
                For ii = 3 To UBound(a, 2)
                    If a(x, ii) <> "" Then
                        ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
                        w(1, UBound(w, 2)) = ws.Name
                        w(2, UBound(w, 2)) = IIf(w(1, UBound(w, 2) - 1) <> ws.Name, 1, Val(w(2, UBound(w, 2) - 1)) + 1)
                        w(3, UBound(w, 2)) = a(2, ii): w(4, UBound(w, 2)) = a(3, ii): w(5, UBound(w, 2)) = a(x, ii)
                        w(6, UBound(w, 2)) = a(1, ii)
                         
                    End If
                Next
            End If
        End If
    Next
    Sheets("Report").Range("a15").Resize(6, UBound(w, 2)).Value = w
End Sub

Hello leprince,

Excel has a newer tool called Power Query that is included in 2016 Excel and is an Add-In for 2010 and 2013 Excel. Your problem*can be solved using this tool, without needing any VBA code.
See https://www.microsoft.com/en-us/down...3-73acbf6aa147 for installing the add in.

Then look at my attached workbook, where I've taken your data and used*the tool on it. I've created a Connection Only to each sheet and then used PQ to Append all of them into a single table on Sheet1. PQ also has a tool called UnPivot, which I did with your data so I could do a Pivot Table with the data. I think my result is what you want. If you need the Lecturer's name that can be included above the topic name using a HLookup from any of the other sheets.

PQ for leprince.xlsm

I did your problem in about 5 minutes without needing to write any VBA code.*

Originally Posted by MarvinP

Hello leprince,

Excel has a newer tool called Power Query that is included in 2016 Excel and is an Add-In for 2010 and 2013 Excel. Your problem*can be solved using this tool, without needing any VBA code.
See https://www.microsoft.com/en-us/down...3-73acbf6aa147 for installing the add in.

Then look at my attached workbook, where I've taken your data and used*the tool on it. I've created a Connection Only to each sheet and then used PQ to Append all of them into a single table on Sheet1. PQ also has a tool called UnPivot, which I did with your data so I could do a Pivot Table with the data. I think my result is what you want. If you need the Lecturer's name that can be included above the topic name using a HLookup from any of the other sheets.

Attachment 494748

I did your problem in about 5 minutes without needing to write any VBA code.*

thank you Mr. MarvinP.could you please record a video to show me steps for dealing with power query in order to solve my problem??

Wow, uncanny - Mike 7952 and I both posted nearly exact code maintenance - Mike's wasn't showing when I posted BTW!

@leprince2007.

I don't use power query so, can't offer any help here.

@leprince - me neither.