VBA - Extracted Worksheet to include VBA Function

The Great SrH

Board Regular
Joined
Jan 16, 2015
Messages
177
Hey,

I'm not entirely sure if this is possible - but i'm hoping you can help me if it is.


I have a Workbook which contains a number of VBA functions built in. The area I want to focus on is the "Extract worksheet" part.


Basically the button will Extract a certain worksheet into a brand new workbook, then send it via Outlook to a recipient.


I'm wondering if there's a way to build in a fixed code to the extracted Worksheet - to include a button which will then give them the option to send this worksheet onto an authoriser?


Any help will be greatly appreciated!


Thanks
 
If my understanding of your process is correct, the crucial bit is how the code adds the 2 buttons to the extracted DFU sheet, in particular what it assigns to each button's OnAction property. OnAction tells the button which routine to call when the button is clicked.

As my comment in the Add_Authoriser_Button routine in post no. 6 says, in this case the OnAction must specify the workbook name surrounded by single quotes, the sheet's code name and the routine name itself, like this:

Code:
        .OnAction = "'" & destSheet.Parent.Name & "'!" & destSheet.CodeName & ".Send_Sheet_To_Authoriser"
so if the workbook is saved as "DFU via TW form - xxxx" and the DFU sheet has the code name "Sheet1" then the OnAction string is:

"'DFU via TW form - xxxx'!Sheet1.Send_Sheet_To_Authoriser"

Otherwise, if the OnAction string is just the routine name, "Send_Sheet_To_Authoriser", then the OnAction will refer to the original workbook, not the workbook which contains the extracted DFU sheet. I hope that makes sense!

Here is the complete code for the original workbook that works for me.

Note that Mail_DFU adds 2 form buttons to the extracted DFU sheet, by making 2 calls to a modified Add_Authoriser_Button routine which allows you to specify the cell where the button should be placed, the button's caption and name:

Code:
    Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("F10"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet

Standard module:
Code:
Sub Mail_DFU()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Visible = True
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False
    
    'Add two buttons to DFU sheet in new workbook
    
    Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("F10"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet
    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        Debug.Print TempFilePath & TempFileName & FileExtStr
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "myemail@email.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            '.Send   'or Display
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Sheets("DFU").Visible = False
    
End Sub


Private Sub Add_Authoriser_Button(destCell As Range, buttonName As String, buttonCaption As String, OnActionRoutine As String)

    Dim btn As Button
    
    'Add a button at the specified cell and assign a routine in the parent sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook (in single quotes), otherwise OnAction will refer to the routine in this workbook
    
    '                                    Add(Left As Double, Top As Double, Width As Double, Height As Double)
    Set btn = destCell.Worksheet.Buttons.Add(destCell.Left, destCell.Top, 120#, 40#)
    With btn
        .OnAction = "'" & destCell.Worksheet.Parent.Name & "'!" & destCell.Worksheet.CodeName & "." & OnActionRoutine
        '.OnAction = destCell.Worksheet.CodeName & "." & OnActionRoutine
        destCell.Offset(4).Value = .OnAction
        .Caption = buttonCaption
        .Name = buttonName
    End With
    
End Sub

DFU sheet module:

This contains the 2 routines to be run by the 2 buttons on the extracted DFU sheet, Send_Sheet_To_Authoriser and Save_Sheet_Authoriser, from your last post. Note that I've added some lines in Send_Sheet_To_Authoriser to delete the 2 buttons on the extracted DFU sheet, because I'm guessing that you don't need them on the DFU sheet that is sent to the Authoriser. Simply delete those lines if I'm wrong.
Code:
Private Sub Send_Sheet_To_Authoriser()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    If MsgBox("Please Note - This will send all information to a chosen Authoriser" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Send TW Form") = vbCancel Then
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    
    'Delete all buttons on the DFU sheet in the new workbook
    Dim btn As Button
    For Each btn In Destwb.Worksheets(1).Buttons
        btn.Delete
    Next
    
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            '.To = ""
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Display   'or use .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub
 
 
Private Sub Save_Sheet_Authoriser()

    Dim wSheet As Worksheet
    Dim vFile As Variant
    Dim sFile As String

    If MsgBox("Please Note - This will save the sheet as a PDF document" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Save Refund Request Form") = vbCancel Then
        Exit Sub
    End If
    
    Set wSheet = ActiveSheet
    sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    vFile = Application.GetSaveAsFilename _
                (InitialFileName:=sFile, _
                    FileFilter:="PDF Files (*.pdf), *.pdf", _
                    Title:="Select Folder and FileName to save")
    If vFile <> "False" Then
        wSheet.Range("A1:I22").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=vFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If
    MsgBox "PDF file has been created."
    
End Sub
Thanks so much again John.

I think the issue will be around the OnAction button as I didn't change the coding like you suggested. To be honest, I didn't really understand what you meant when first mentioning it - but you've definitely cleared it up for me now!


I'm just struggling on how to tweek the code to work with my extracted spreadsheet due to the name not being static. As you know, my worksheet name is calculated by the below:

Code:
"PeopleSoft via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss"


The sheet is simply "DFU".


I tried to name the On Action to this:

Code:
"'""PeopleSoft via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss""'"!DFU.Send_Sheet_To_Authoriser"


I get a "Compile error: Expected: list separator or)"


I think once I get through this issue, it may resolve the other problem!


Thanks
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
I'm just struggling on how to tweek the code to work with my extracted spreadsheet due to the name not being static. As you know, my worksheet name is calculated by the below:

Code:
"PeopleSoft via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss"


The sheet is simply "DFU".


I tried to name the On Action to this:

Code:
"'""PeopleSoft via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss""'"!DFU.Send_Sheet_To_Authoriser"


I get a "Compile error: Expected: list separator or)"


I think once I get through this issue, it may resolve the other problem!


Thanks
It doesn't matter if the extracted worksheet name isn't static, because the call to Add_Authoriser_Button specifies the worksheet's index number, not its name, in the first argument (the cell where the button will be placed):

Code:
Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
and we know that the extracted worksheet is the only sheet in Destwb, so its index is 1.

Within Add_Authoriser_Button, destCell.Worksheet.Parent.Name is the name of the workbook, and destCell.Worksheet.CodeName is the code name of the sheet. Therefore it constructs the OnAction string with the correct workbook name and sheet.

So all you need to do to place a button on any sheet is to call Add_Authoriser_Button with the appropriate arguments.
 
Upvote 0
It doesn't matter if the extracted worksheet name isn't static, because the call to Add_Authoriser_Button specifies the worksheet's index number, not its name, in the first argument (the cell where the button will be placed):

Code:
Add_Authoriser_Button Destwb.Worksheets(1).Range("C10"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
and we know that the extracted worksheet is the only sheet in Destwb, so its index is 1.

Within Add_Authoriser_Button, destCell.Worksheet.Parent.Name is the name of the workbook, and destCell.Worksheet.CodeName is the code name of the sheet. Therefore it constructs the OnAction string with the correct workbook name and sheet.

So all you need to do to place a button on any sheet is to call Add_Authoriser_Button with the appropriate arguments.

I’m really sorry but it’s the “appropriate arguments” that I think I’m struggling with so much.

I’m such an amateur, sorry!
 
Upvote 0
I've gone back and tested all the code you sent previously. Something that I forgot to mention is I'm duplicating the code for an additional "PeopleSoft" sheet. So the issue I have with the extracted DFU sheet, also happens on the extracted "PeopleSoft" sheet.

Ive also noticed that your code seems to be adding some wording to the worksheet below the button.
 
Upvote 0
I’m really sorry but it’s the “appropriate arguments” that I think I’m struggling with so much.

I’m such an amateur, sorry!
There are 4 arguments:

Code:
Private Sub Add_Authoriser_Button(destCell As Range, buttonName As String, buttonCaption As String, OnActionRoutine As String)
1. destCell - The destination cell where you want the button to be placed. The caller fully qualifies this cell by specifying the destination workbook, worksheet and cell: Destwb.Worksheets(1).Range("C10").

2. buttonName - The name to be given to the button. This can be anything but must be unique - you can't have buttons with the same name.

3. buttonCaption - The caption to be given to the button.

4. OnActionRoutine - The name of the routine (in the worksheet module of the 1st argument) which will be called when the button is clicked.

Note that the button is given a fixed size - 120.0 points wide and 40.0 points high, which you can change if required.

Here is the complete routine:

Code:
Private Sub Add_Authoriser_Button(destCell As Range, buttonName As   String, buttonCaption As String, OnActionRoutine As String)

    Dim btn As Button
    
    'Add a button at the specified cell and assign a routine in the parent sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook (in single quotes), otherwise OnAction will refer to the routine in this workbook
    
    '                                    Add(Left As Double, Top As Double, Width As Double, Height As Double)
    Set btn = destCell.Worksheet.Buttons.Add(destCell.Left, destCell.Top, 120#, 40#)
    With btn
        .OnAction = "'" & destCell.Worksheet.Parent.Name & "'!"   & destCell.Worksheet.CodeName & "." & OnActionRoutine
        .Caption = buttonCaption
        .Name = buttonName
    End With
    
End Sub

I've gone back and tested all the code you sent previously. Something that I forgot to mention is I'm duplicating the code for an additional "PeopleSoft" sheet. So the issue I have with the extracted DFU sheet, also happens on the extracted "PeopleSoft" sheet.

Ive also noticed that your code seems to be adding some wording to the worksheet below the button.

Can you try my code with just the DFU sheet and see if it works? If that works then I think you will need to put the OnAction routine(s) for the button(s) on the PeopleSoft sheet in the PeopleSoft sheet module, similar to the OnAction routines (Send_Sheet_To_Authoriser and Save_Sheet_Authoriser) for the DFU sheet.

Sorry, the extra wording is the OnAction string put in by the destCell.Offset(4).Value = .OnAction line and was for debugging purposes - I have removed it in the routine above.
 
Upvote 0
That seems to do the trick for me now, thank you so much!

The issue I seem to have now relates to the PeopleSoft extract. I tried copying the code but it doesn't seem to do the same. I will send my full codes below (they're changed slightly to what you suggested):

Code located in original workbook - Module called "NewMail":

Code:
Sub SendRefunds()
'This will check the Control tab and then send the additional sheets depending on if PeopleSoft/DFU are on Form sheet

If Sheets("Control").Range("D2").Value = "DFU" Then
Call Mail_DFU
Call Clearcells
MsgBox "DFU refund sent to Finance Team via TW Form", , "TW Form Sent"
ElseIf Sheets("Control").Range("D2").Value = "PeopleSoft" Then
Call Mail_PeopleSoft
Call Clearcells
MsgBox "PeopleSoft refund sent to Finance Team via TW Form", , "TW Form Sent"
ElseIf Sheets("Control").Range("D2").Value = "Both" Then
Call Mail_DFU
Call Mail_PeopleSoft
Call Clearcells
MsgBox "DFU & PeopleSoft refunds sent to Finance Team via TW Form", , "TW Form Sent"
Else
MsgBox "No information to send", , "TW Form"
End If
End Sub
Sub Mail_DFU()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("DFU").Visible = True
    Sheets("DFU").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
    'Add two buttons to DFU sheet in new workbook
    
    Add_Authoriser_Button Destwb.Worksheets(1).Range("L20"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("L13"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet
    
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "DFU via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "DFU via TW Form"
            .Body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
        
    Sheets("DFU").Visible = False
End Sub



Sub Mail_PeopleSoft()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    Sheets("PeopleSoft").Visible = True
    Sheets("PeopleSoft").Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
        
       'Add two buttons to DFU sheet in new workbook
    
    Add_Authoriser_Button Destwb.Worksheets(1).Range("L20"), "btnSendSheet", "Send this sheet to an Authoriser", "Send_Sheet_To_Authoriser"     'Email the sheet
    Add_Authoriser_Button Destwb.Worksheets(1).Range("L13"), "btnSaveSheet", "Save this sheet as a PDF document", "Save_Sheet_Authoriser"       'Save the sheet
    
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "PeopleSoft via TW Form - " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "PeopleSoft via TW Form"
            .Body = "Hi there"
            .Attachments.Add Destwb.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Sheets("PeopleSoft").Visible = False
End Sub

Private Sub Add_Authoriser_Button(destCell As Range, buttonName As String, buttonCaption As String, OnActionRoutine As String)
    Dim btn As Button
    
    'Add a button at the specified cell and assign a routine in the parent sheet's module as its OnAction macro.  We must
    'specify the name of the parent workbook (in single quotes), otherwise OnAction will refer to the routine in this workbook
    
    '                                    Add(Left As Double, Top As Double, Width As Double, Height As Double)
    Set btn = destCell.Worksheet.Buttons.Add(destCell.Left, destCell.Top, 112.53, 58.39)
    With btn
        .OnAction = "'" & destCell.Worksheet.Parent.Name & "'!" & destCell.Worksheet.CodeName & "." & OnActionRoutine
        .Caption = buttonCaption
        .Name = buttonName
        .Font.Name = "Tahoma"
        .Font.Size = 11
    End With
    
End Sub

This is the code now in "DFU" worksheet on original excel:

Code:
Private Sub Send_Sheet_To_Authoriser()

   
    If MsgBox("Please Note - This will send all information to a chosen Authoriser" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Send TW Form") = vbCancel Then
        Exit Sub
    End If
    
    
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        '.To = ""
        .CC = ""
        .BCC = ""
        .Subject = "DFU Refund via TW Form"
        .Body = "Hello World!"
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

 
Private Sub Save_Sheet_Authoriser()
    Dim wSheet As Worksheet
    Dim vFile As Variant
    Dim sFile As String

    If MsgBox("Please Note - This will save the sheet as a PDF document" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Save Refund Request Form") = vbCancel Then
        Exit Sub
    End If
    
    Set wSheet = ActiveSheet
    sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    vFile = Application.GetSaveAsFilename _
                (InitialFileName:=sFile, _
                    FileFilter:="PDF Files (*.pdf), *.pdf", _
                    Title:="Select Folder and FileName to save")
    If vFile <> "False" Then
        wSheet.Range("A1:I22").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:=vFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If
    MsgBox "PDF file has been created."

End Sub

This code is within the "PeopleSoft" worksheet in the main Excel:
Code:
Private Sub Send_Sheet_To_Authoriser()
    
    If MsgBox("Please Note - This will send all information to a chosen Authoriser" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Send TW Form") = vbCancel Then
        Exit Sub
    End If
    
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        '.To = ""
        .CC = ""
        .BCC = ""
        .Subject = "PeopleSoft Refund via TW Form"
        .Body = "Hello World!"
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub
 
Private Sub Save_Sheet_Authoriser()
    Dim wSheet As Worksheet
    Dim vFile As Variant
    Dim sFile As String
    If MsgBox("Please Note - This will save the sheet as a PDF document" & vbNewLine & vbNewLine & "Do you want to continue?", vbOKCancel, "Save Refund Request Form") = vbCancel Then
        Exit Sub
    End If
    
    Set wSheet = ActiveSheet
    sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    vFile = Application.GetSaveAsFilename _
                (InitialFileName:=sFile, _
                    FileFilter:="PDF Files (*.pdf), *.pdf", _
                    Title:="Select Folder and FileName to save")
    If vFile <> "False" Then
        wSheet.Range("A1:I22").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:=vFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If
    MsgBox "PDF file has been created."
End Sub

Thanks for your help and patience!
 
Upvote 0
Your code works for me, for both DFU and PeopleSoft sheets, extracted and sent. Though, because of my macro security setting, I have to enable macros in the emailed workbooks.

What is the issue? Are any error messages displayed? If so, what is the exact error message?
 
Upvote 0
Your code works for me, for both DFU and PeopleSoft sheets, extracted and sent. Though, because of my macro security setting, I have to enable macros in the emailed workbooks.

What is the issue? Are any error messages displayed? If so, what is the exact error message?

I click send on the original workbook which will then extract DFU and PeopleSoft worksheets into a new workbook, and send to the designated destination.

I close the original workbook.

Go to e-mail and load up the one sent (PeopleSoft for example), and enable macro.

It then shows this message:
"We can't update some of the links in your workbook right now.


You can continue without updating their values, or edit the links you think are wrong."

I then click "Edit Links" and it shows the original workbook
 
Upvote 0
Received your dummy workbook, thanks.

I see the problem and it had me stumped for a while. It is caused by Data Validation in cells B3:B16 on the DFU and PeopleSoft sheets, which refer to cells on the Control sheet. The solution is to add this line after Set Destwb = ActiveWorkbook in Mail_DFU and Mail_PeopleSoft:

Code:
    Destwb.Worksheets(1).Cells.Validation.Delete
With this, cells B3:B16 in the extracted DFU or PeopleSoft sheet are just values and no longer refer to cells in the original workbook.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,541
Latest member
iparraguirre89

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