Combine multi tab event attendance data into one worksheet

YellowTangerine

New Member
Joined
Mar 5, 2023
Messages
29
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello, I need to combine into one worksheet names of delegates who have attended training events. There will be a tab for each event with a list of delegate names. In several cases delegates have attended several events and in other cases only a specific event. I need to create a master worksheet with an alpha list of all delegates in the last 5 years showing which training event they attended.

I am no expert on Excel, but wondered if someone might be able to advise me on how best to achieve this?

Here's how I have set up the master worksheet and the data for each event will be in the tabs (shown at the bottom of the pic): There will eventually be a total of 35 events (columns on the master worksheet). The delegate name will appear once in column A and the columns for each event simply need an Y added for attending the event.

Screenshot 2023-06-11 at 20.48.07.png
 
Apologies, try this one instead

VBA Code:
Option Explicit
Sub Test()
Dim i%, m%, n%, j%, k%
Dim a As Variant
Dim t As Variant
Dim t2 As Variant
Dim dict as new dictionary
dict.Comparemode = vbTextCompare
ReDim b(1 To 5000, 1 To 6)

m = 1
For i = 2 To Worksheets.Count
        With Sheets(i)
           a = .Range("a2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
            j = j + 1
           b(1, j + 1) = Sheets(i).Name
       
           For k = 1 To UBound(a, 1)

                If Not dict.exists(a(k, 1)) Then
                    m = m + 1
                    n = m
                     dict.Add a(k, 1), n
                     b(n, 1) = a(k, 1)
                 Else
                    n = dict.Item(a(k, 1))
                 End If
             
                b(n, j + 1) = a(k, 1)
           Next k
       
        End With
Next i

Sheets("Consolidated Data").Select
[a2].Resize(m, Worksheets.Count).Value = b
[a2].Resize(m, Worksheets.Count).Sort Range("a3"), order1:=xlAscending, Header:=xlYes

End Sub
 
Last edited:
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I think that I have a workbook that does what was requested. Be aware that my code tends to be much klunkier and slower than the much more elegant solutions provided by experts. In my case I do include lots of comments and I name my variable with more recognizable names so the code is understandable and maintainable by someone who is not that familiar with VBA.

The workbook is HERE. Admittedly Klunky code is below.

VBA Code:
Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: GetNamesForEvents
' Purpose: Put names into the correct Event sheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------
Sub GetNamesForEvents()

    Dim wsConsolidated As Worksheet
    
    Dim wsLoop As Worksheet
    
    Dim rAnchorCellConsolidated As Range

    Dim asNamesArray() As String
    
'   Used to iterate through all names.
    Dim iName As Long
    
'   The current name being processed.
    Dim sName As String
    
'   Count of event worksheets.
    Dim iEventSheetCount As Long
    
'   Column number for an event in the Consolidated worksheet.
    Dim iEventColumnNumber As Long
    
'   => Change this if the name of the Consolidated Data
'      worksheet changes.
    Set wsConsolidated = Worksheets("Consolidated Data")
    
'   => Change this if the location of the upperleftmost cell
'      in the Consolidated Data worksheet -- the Member Name header --
'      changes.
    Set rAnchorCellConsolidated = wsConsolidated.Range("A1")
   
'   Do not show screen updates while this sub is processing.
    Application.ScreenUpdating = False
   
'   Call function that puts all names into an array.
    Call NamesIntoArray(asNamesArray)
    
'   Get a count of the number of event worksheets.
    For Each wsLoop In Worksheets
        If Not UCase(wsLoop.Name) Like UCase(wsConsolidated.Name) _
         Then iEventSheetCount = iEventSheetCount + 1
    Next wsLoop
    
'   Clear existing data. Assumes that the number of Events in Consolodated worksheet
'   is equal to the number of event worksheets (tabs) plus two. Plus two in case there
'   are one or two events listed in Consolodated worksheet for which there is no Event
'   worksheet.
    rAnchorCellConsolidated.Offset(1, 1).Resize(UBound(asNamesArray), iEventSheetCount + 2).ClearContents
    
'   Iterate through each name to determine if it is in an Event worksheet.
    For iName = 1 To UBound(asNamesArray)
        
'       Get the name to process from the names array.
        sName = asNamesArray(iName)
        
'       Iterate though each worksheet to find an Event sheet.
        For Each wsLoop In Worksheets
        
'           Only process an Event worksheet.
            If Not UCase(wsLoop.Name) Like UCase(wsConsolidated.Name) _
             Then
             
'               If the name being processed is present in the Event sheet
'               then put it into the event-specific column in the Consolidated
'               Data worksheet.
                If NameIsInEventSheet(wsLoop, sName) _
                 Then
                    
'                   Get the Event-specific column number in the Consolidated Data worksheet.
'                   All event worksheet tab name and the corresponding event name in the
'                   Consolidated Data worksheet are exactly the same!
                    iEventColumnNumber = GetEventColumnNum(wsLoop.Name, rAnchorCellConsolidated)
                    
'                   Put Y into the cell for the name found for the Event.
                    rAnchorCellConsolidated.Offset(iName, iEventColumnNumber) = "Y"
                   
                End If
                
            End If
        
        Next wsLoop
    
    Next iName
        
End Sub

VBA Code:
Option Explicit

' ----------------------------------------------------------------
' Procedure Name: GetEventColumnNum
' Purpose: Determine which Event column contains he specified Event name.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psEventName (String): Name of the Event to look for.
' Parameter prAnchorCell (Range): Upperleftmost cell in the data =>  the Names header.
' Return Type: Long
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------
'Return value of zero if the Event name is not found in the Events column
'in the Consolidated Data worksheet.

Function GetEventColumnNum(psEventName As String, prAnchorCell As Range) As Long

    Dim iHeaderNum As Long
    
    iHeaderNum = 0
    
    GetEventColumnNum = 0
    
    Do Until prAnchorCell.Offset(0, iHeaderNum + 1) = ""
        
        iHeaderNum = iHeaderNum + 1
        
        If prAnchorCell.Offset(0, iHeaderNum).Value = psEventName _
         Then
            GetEventColumnNum = iHeaderNum
            Exit Function
        End If
        
    Loop

End Function

VBA Code:
Option Explicit

' ----------------------------------------------------------------
' Procedure Name: NameIsInEventSheet
' Purpose: Determine if a name is in the specified Event worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter pwsEventSheet (Worksheet): Event worksheet to look in.
' Parameter psName (String): Name of the person to look for in the Event worksheet.
' Return Type: Boolean
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------

Function NameIsInEventSheet(pwsEventSheet As Worksheet, psName As String) As Boolean
    
    Dim rAnchorCell As Range
    
    Dim iRowOffset As Long
    
'   => Change this if the location of the names in Events worksheet
'      changes. Currently it is assumed that cell A1 is the upperleftmost
'      data cell (i.e., the cell containing the header label for names).
    Set rAnchorCell = pwsEventSheet.Range("A1")
    
    iRowOffset = 0
    
    NameIsInEventSheet = False
        
'   Iterate through all names present in the Event sheet being processed
'   to determine if the name psName is in that worksheet.
    Do Until rAnchorCell.Offset(iRowOffset + 1) = ""
    
        iRowOffset = iRowOffset + 1
    
        If rAnchorCell.Offset(iRowOffset) = psName _
         Then
            NameIsInEventSheet = True
            Exit Function
        End If
        
    Loop
    
End Function

VBA Code:
Option Explicit

' ----------------------------------------------------------------
' Procedure Name: NameIsInEventSheet
' Purpose: Determine if a name is in the specified Event worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter pwsEventSheet (Worksheet): Event worksheet to look in.
' Parameter psName (String): Name of the person to look for in the Event worksheet.
' Return Type: Boolean
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------

Function NameIsInEventSheet(pwsEventSheet As Worksheet, psName As String) As Boolean
    
    Dim rAnchorCell As Range
    
    Dim iRowOffset As Long
    
'   => Change this if the location of the names in Events worksheet
'      changes. Currently it is assumed that cell A1 is the upperleftmost
'      data cell (i.e., the cell containing the header label for names).
    Set rAnchorCell = pwsEventSheet.Range("A1")
    
    iRowOffset = 0
    
    NameIsInEventSheet = False
        
'   Iterate through all names present in the Event sheet being processed
'   to determine if the name psName is in that worksheet.
    Do Until rAnchorCell.Offset(iRowOffset + 1) = ""
    
        iRowOffset = iRowOffset + 1
    
        If rAnchorCell.Offset(iRowOffset) = psName _
         Then
            NameIsInEventSheet = True
            Exit Function
        End If
        
    Loop
    
End Function
 
Upvote 0
I apologize for the incorrect post. I did not include this function.

VBA Code:
Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: NamesIntoArray
' Purpose: Fill an array with names.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter pasNamesArray (String): The array to fill.
' Return Type: String)
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------

Function NamesIntoArray(pasNamesArray() As String)

    Dim wsConsolidated As Worksheet
   
    Dim asNamesArray() As String
    
    Dim iNameRowOffset As Long
    
    Dim rAnchorCell As Range
    
    Dim sAnchorCellAddress As String
    
    ReDim asNamesArray(1)
    
    Set wsConsolidated = Worksheets("Consolidated Data") '<= Change this if name of worksheet changes.
    
'   Upper leftmost cell in the Consolidated Data worksheet (column header).
    sAnchorCellAddress = "A1" '<= Change this if the upperleftmost cell -- header label -- in the data changes.
    
    With wsConsolidated

       Set rAnchorCell = .Range(sAnchorCellAddress)
       
       iNameRowOffset = 0
       
        Do Until rAnchorCell.Offset(iNameRowOffset + 1) = ""
       
            iNameRowOffset = iNameRowOffset + 1
            
            ReDim Preserve pasNamesArray(iNameRowOffset)
            
            pasNamesArray(iNameRowOffset) = rAnchorCell.Offset(iNameRowOffset)
            
        Loop
    
    End With
        
End Function
 
Upvote 0
It occurred to me that instead of Y indicating attendance that it would be more elegant to use a check mark. I also centered the character. If that sounds good then replace

VBA Code:
'                   Put Y into the cell for the name found for the Event.
                    rAnchorCellConsolidated.Offset(iName, iEventColumnNumber) = "Y"

With this

VBA Code:
'                   Put check mark into the cell for the name found for the Event. Center it.
                    With rAnchorCellConsolidated.Offset(iName, iEventColumnNumber)
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .Value = "ü"
                        .Font.Name = "Wingdings"
                    End With
 
Upvote 0
Sorry not to have responded earlier. I will look at this tomorrow and see which options work best. Am truly grateful and definitely like the idea of putting a tick in the column of the event attended.
I will let you know how I get on.
Just checking on the thread, I am not clear on which code I should use. Are they all options? except with the change from Y to check mark?
 
Upvote 0
I ran a few of the codes and either they error or I get this showing..... The last but one code shows like this
 
Upvote 0
Not sure how to answer. The link to the workbook in previous message has all of the code that was posted and should be operational. I just tried it with no errors.

It puts check marks NOT Y.

Feel free to use code from RedBud if it does what you want. His code is tighter and probably faster. Mine is klunkier but I try to make it readable.

Let me know how I help you to get this up and running.
 
Upvote 0
Oh dear. I had other spreadsheets open and after trying to run the code the data has disappeared, including on the spreadsheet you have been helping me with. Hmm. How would that happen?
 
Upvote 0

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top