Creating sheets from rows on a "Master Roster" sheet with each new sheet being a copy of a template

juscuz419

Board Regular
Joined
Apr 18, 2023
Messages
57
Office Version
  1. 2019
Platform
  1. Windows
I have a workbook that has a Master Roster Sheet and a Template sheet among others. The Master Roster sheet can and does change frequently from event to event. The Template sheet has cells that are populated from the Master Roster Sheet. I currently manually create a new copy of the template sheet for each row that is not blank within a range on the Master Roster sheet and then go to each sheet and repair the cell reference back to the Master Roster row for that individual sheet.
What I would like to build is a macro button that can be selected to run when the Master Roster range is complete for each event that creates a new sheet that is a copy of the template sheet with the cell references on each sheet accurately pointing back to specific information for a row in the Master Roster sheet
 
I understand about sharing the workbook. But I cannot figure out what the issue is without it.

Not sure if this helps but regarding
Things would be a lot easier if the same checkbox could exist in multiple places.
You can have more than one checkbox that "points" to a given cell/value. Say that you have Checkbox1 and Checkbox2 that both point to cell A1. If Checkbox1 is clicked (set to checked) then Checkbox2 will also be checked.

As a bonus topic, you can assign a macro to a checkbox. To do that right click on a checkbox and assign macro.

Consider this which unchecks three checkboxes if the "None" checkbox is clicked. Note that I named the four checkboxes.

VBA Code:
Sub ClickNoneCheckbox()

    With ActiveSheet
    
        If .CheckBoxes("None_CheckBox").Value = xlOn _
         Then
         
            .CheckBoxes("FWD_Checkbox").Value = xlOff
            .CheckBoxes("Personal_CheckBox").Value = xlOff
            .CheckBoxes("Rental_CheckBox").Value = xlOff

        End If
    
    End With

End Sub
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Your "uploading and linking" worked fine.

You were referring to the wrong names for headers!

Replace

VBA Code:
                    .Range("NoneVehicle").Value = [MasterRoster].Range("Header_VehicleNone").Offset(iRow).Value
                    
                    .Range("RentalVehicle").Value = [MasterRoster].Range("Header_VehicleRental").Offset(iRow).Value
                    
                    .Range("PersonalVehicle").Value = [MasterRoster].Range("Header_VehiclePersaonal").Offset(iRow).Value
                    
                    .Range("_2WDVehicle").Value = [MasterRoster].Range("Header_Vehicle2WD").Offset(iRow).Value
                    
                    .Range("_4WDAWDVehicle").Value = [MasterRoster].Range("Header_Vehicle4WDAWD").Offset(iRow).Value

With

VBA Code:
                    .Range("NoneVehicle").Value = [MasterRoster].Range("Header_NoneVehicle").Offset(iRow).Value
                    
                    .Range("RentalVehicle").Value = [MasterRoster].Range("Header_RentalVehicle").Offset(iRow).Value
                    
                    .Range("PersonalVehicle").Value = [MasterRoster].Range("Header_PersonalVehicle").Offset(iRow).Value
                    
                    .Range("_2WDVehicle").Value = [MasterRoster].Range("Header_2WDVehicle").Offset(iRow).Value
                    
                    .Range("_4WDAWDVehicle").Value = [MasterRoster].Range("Header_4WDAWDVehicle").Offset(iRow).Value
 
Upvote 0
Worked like a champ. Feel like an idiot. I try to figure these things out myself in an effort to learn. I'll admit that I start getting cross-eyed after a while. I am trying to write some code that will take all of the individual sheets that your macro creates, saves them as a pdf and emails them as an attachment to the email address found in range("J12") of each sheet. I've got it working for one sheet right now and am trying to work through the the looping process. Once I get that done, I'm going to try to save all of the sheets as one multipage pdf and email it as attachment to the address found in range("N38") of the template. Wish me luck.
 
Upvote 0
Heheh, I sort of expected that you'd say something like "feel like an idiot." Nonetheless, more often than I'll admit I just need a second set of eyes to look at what I've been staring at and what stupid code development that I did.

I'm happy to do some coding. Wife is away today. Warriors (home town team) don't play 'til 5:30.

See if this helps. It creates then sends each person-specific PDF by email. Wasn't sure where the email address(es) come from.

VBA Code:
Option Explicit

Sub CreatePersonSpecificPDFs()

'   -------------------------------
'            Declarations
'   -------------------------------

'   Workbook object used 1. to loop through worksheets,
'   2. specify which worksheet to export as PDF.
    Dim wsSource As Worksheet
    
    Dim sEmailAddress As String
    
'   File name and location.
    Dim sPath As String
    Dim sFileName As String
    Dim sFileSpec As String
    
'   Array holding "tab names" of person-specific worksheets.
    Dim asSheetTabNames() As String
    
'   Count of qualifying worksheets.
    Dim iSheetsFound As Long
    
'   Used for looping person-specific worksheets found.
    Dim iSheet As Long
    
'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object
    
'   -------------------------------
'           Initializations
'   -------------------------------

    sPath = ThisWorkbook.Path & "\"
    
    iSheetsFound = 0
    
'   -------------------------------
'        ID Sheets to Export
'   -------------------------------
    
'   Iterate through the worksheets collection looking for person-
'   specific worksheets to be exported as a PDF file.
'   Load person-specific worksheet TAB names into the array.
    For Each wsSource In ThisWorkbook.Worksheets
        
'       Use worksheets' "code names" to determine which worksheets are to be exported.
'       A person-specific worksheet has codename like Template# or like Template##
'       where # is a wildcard indicating any numeric value.
        If wsSource.CodeName Like "Template#" Or wsSource.CodeName Like "Template##" _
         Then
             
            iSheetsFound = iSheetsFound + 1
            
            ReDim Preserve asSheetTabNames(iSheetsFound)
            
            asSheetTabNames(iSheetsFound) = wsSource.Name
             
        End If
        
    Next wsSource
    
'   ---------------------------------
'        Export then Email PDFs
'   ---------------------------------
    
    For iSheet = 1 To iSheetsFound
    
        sFileName = asSheetTabNames(iSheet) & ".PDF"
        
        sFileSpec = sPath & sFileName

'       Delete the file if it already exists.
        On Error Resume Next
        Kill sFileSpec
        On Error GoTo 0

        Set wsSource = ThisWorkbook.Worksheets(asSheetTabNames(iSheet))
    
        wsSource.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sFileSpec, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

'       Get email address from the person-specific worksheet. NOT TESTED
'       sEmailAddress = wsSource.Range("EmailAddress").Value

'       Use coder's email address for testing.
        sEmailAddress = "jim@jimeyer.net"

'       Set up Outlook objects for sending email.
        Set oOutlookApp = CreateObject("Outlook.Application")
        Set oMailItem = oOutlookApp.CreateItem(0)
        
'       Attach the single person-specific PDF file to an email.
        With oMailItem
            .To = sEmailAddress  'Specify the email address of the recipient
            .Subject = "Person-specific PDF"
            .Body = "Please find attached the PDF files for the tab"
            .Attachments.Add sFileSpec
            .Send
        End With
        
        Set oOutlookApp = Nothing
        Set oMailItem = Nothing

    Next iSheet

End Sub
 
Upvote 0
I'd swear but don't want to get kicked off the list so Darn! I meant to put a check in the PDF code for no person-specific worksheets were found.

VBA Code:
Option Explicit

Sub CreatePersonSpecificPDFs()

'   -------------------------------
'            Declarations
'   -------------------------------

'   Workbook object used 1. to loop through worksheets,
'   2. specify which worksheet to export as PDF.
    Dim wsSource As Worksheet
    
    Dim sEmailAddress As String
    
'   File name and location.
    Dim sPath As String
    Dim sFileName As String
    Dim sFileSpec As String
    
'   Array holding "tab names" of person-specific worksheets.
    Dim asSheetTabNames() As String
    
'   Count of qualifying worksheets.
    Dim iSheetsFound As Long
    
'   Used for looping person-specific worksheets found.
    Dim iSheet As Long
    
'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object
    
    Dim sMsg As String
    
'   -------------------------------
'           Initializations
'   -------------------------------

    sPath = ThisWorkbook.Path & "\"
    
    iSheetsFound = 0
    
'   -------------------------------
'        ID Sheets to Export
'   -------------------------------
    
'   Iterate through the worksheets collection looking for person-
'   specific worksheets to be exported as a PDF file.
'   Load person-specific worksheet TAB names into the array.
    For Each wsSource In ThisWorkbook.Worksheets
        
'       Use worksheets' "code names" to determine which worksheets are to be exported.
'       A person-specific worksheet has codename like Template# or like Template##
'       where # is a wildcard indicating any numeric value.
        If wsSource.CodeName Like "Template#" Or wsSource.CodeName Like "Template##" _
         Then
             
            iSheetsFound = iSheetsFound + 1
            
            ReDim Preserve asSheetTabNames(iSheetsFound)
            
            asSheetTabNames(iSheetsFound) = wsSource.Name
             
        End If
        
    Next wsSource
    

'   -------------------------------------------------
'        Check no Person-specific Sheets Found
'   -------------------------------------------------

    If iSheetsFound = 0 _
     Then
        sMsg = "No person-specific worksheets were found"
        MsgBox sMsg, vbCritical, "Create then email PDFs"
        Exit Sub
    End If

'   ---------------------------------
'        Export then Email PDFs
'   ---------------------------------
        
    For iSheet = 1 To iSheetsFound
    
        sFileName = asSheetTabNames(iSheet) & ".PDF"
        
        sFileSpec = sPath & sFileName

'       Delete the file if it already exists.
        On Error Resume Next
        Kill sFileSpec
        On Error GoTo 0

        Set wsSource = ThisWorkbook.Worksheets(asSheetTabNames(iSheet))
    
        wsSource.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sFileSpec, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

'       Get email address from the person-specific worksheet.
'       sEmailAddress = wsSource.Range("EmailAddress").Value

'       Use coder's email address for testing.
        sEmailAddress = "jim@jimeyer.net"

'       Set up Outlook objects for sending email.
        Set oOutlookApp = CreateObject("Outlook.Application")
        Set oMailItem = oOutlookApp.CreateItem(0)
        
'       Attach the single person-specific PDF file to an email.
        With oMailItem
            .To = sEmailAddress  'Specify the email address of the recipient
            .Subject = "Person-specific PDF"
            .Body = "Please find attached the PDF files for the tab"
            .Attachments.Add sFileSpec
            .Send
        End With
        
        Set oOutlookApp = Nothing
        Set oMailItem = Nothing

    Next iSheet

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,553
Messages
6,114,279
Members
448,562
Latest member
Flashbond

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