Can I use VBA based on Cell Validation?

sdmcavoy · Apr 6, 2023

Hi All - I'm looking for some help (obviously).

Every Fall we send out Excel calendars to our seasonal staff. They select their committment days and return the Workbook. This year, I am trying somenting different. I will start by saying I haven't coded anyting since 7th grade and I'm 54 now.

I was able to code a command button to email the specific sheet within a workbook to me and a few key people. That seems to be working. However, what I would like to do in addition, is email specific people based on the specific work area:

[Each workbook has this in the first 5 rows]

[Sheets of the workbook]

Each area (Privates & Adults/Mountain Camp/Snow Camp) has a different manager and they each have two (2) Supervisors. I would like to be able to have each Core Area Manager and their Supervisors get emailed (and I would want to be copied) once the seasonal staff has hit "Submit". Below is the code VBA code I am using for the Command Button. Is there a way to have the "Submit" button email based on the work area? The sheets will be protected so the fomulas I have within are protected from change.

Bonus would be if the person submitting the information would also get a copy. I can add an email field below the phone number if needed. Double Bonus is if I can get the email subject to have the last name of the person submitting the calendar.

TIA
Shannon

Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xls
x"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
Filename = Wb.Name & Format(Now, "dd-mmm-yy")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & Filename & xFile, FileFormat:=xFormat
With OutlookMail
.To = "(ME)@vail.com"
.CC = "(Snow Camp Manager)@vail.com;(Mountain Camp Manager)@vail.com;(Privates & Adults Manager)@vail.com"
.BCC = ""
.Subject = "SRS 2023-24 Schedule"
.Body = "Please keep a copy for yourself or CC yourself on this email." & vbNewLine & vbNewLine & _
"" & vbNewLine & vbNewLine & _
"You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
"Snow Camp - " & vbNewLine & _
"Mountain Camp - " & vbNewLine & _
"Privates & Adults - " & vbNewLine & _
"" & vbNewLine & vbNewLine & _
"Thank you for submitting your schedule."
On Error Resume Next
.Attachments.Add Wb2.FullName
.Display 'or use .Send
End With
Wb2.Close
Kill FilePath & Filename & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

OaklandJim · Apr 8, 2023

It would be helpful if you could post the workbook as a link using Box, Dropbox or 1Drive. Otherwise someone attempting to assist may have to create a mock-up workbook with fake data -- which is unlikely -- or there is no way to test code.

Here is an edited version of your code. NOT TESTED! I started there for readability with some comments and questions.

VBA Code:

Option Explicit '<= this forces declaration of all variables before they can be used.

'Is sub this in a worksheet's code module, hence the Private designation?
'It seems better to have it in a regular code module. And maybe give it a descriptive
'name such as Sub SendmailToManagers(). Right click your button to "Assign Macro" to it.

Private Sub CommandButton1_Click()

'   Ideally you declare all variables used.

    Dim xOutlookObj As Object  '<= not used
    
    Dim xOutApp As Object '<= not used
    
    Dim xOutMail As Object '<= not used
    
    Dim oOutlookApp As Object
    
    Dim oOutlookMail As Object
    
    Dim sMailBody As String
    
    Dim Wb As Workbook
    
    Dim Wb2 As Workbook
    
    Dim xFormat As Variant
    
    Dim sFilePath As String

    Dim sFilename As String
    
    Dim sFileExtension As String
    
'   Declaring recipients like this makes it easier to change them if a manager changes.
    Dim sMe As String

    Dim sSnowCampManager As String

    Dim sMountainCampManager As String

    Dim PrivatesAndAdultsManager As String

'   Set names for recipients.
    sMe = "Bob"

    sSnowCampManager = "Tamika"

    sMountainCampManager = "Jalen"

    PrivatesAndAdultsManager = "Zack"
    
'   Ideally you make sparing use of this. Why is it here? Where does code choke?
    On Error Resume Next

    Set Wb = Application.ActiveWorkbook
    
    ActiveSheet.Copy "<= What is this for?"
    
    Set Wb2 = Application.ActiveWorkbook 'Wb and Wb2 are the same? Do you NEED both?

'   So the workbook to be sent is NOT always the same type? Otherwise this seems unnecessay?
    Select Case Wb.FileFormat
    
    Case xlOpenXMLWorkbook: '<= do you ever send this type of workbook?
        
        sFileExtension = ".xls"
        'x "" <= this will cause an error
        xFormat = xlOpenXMLWorkbook
    
    Case xlOpenXMLWorkbookMacroEnabled:
    
        If Wb2.HasVBProject Then
            sFileExtension = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            sFileExtension = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
    
    Case Excel8:
    
        sFileExtension = ".xls" '<= do you ever send this type of workbook?
        xFormat = Excel8
    
    Case xlExcel12:  '<= do you ever send this type of workbook?
    
        sFileExtension = ".xlsb"
        xFormat = xlExcel12
    
    End Select

    sFilePath = Environ$("temp") & "\"

    sFilename = Wb.Name & Format(Now, "dd-mmm-yy")
    
    Set oOutlookApp = CreateObject("Outlook.Application")
    
    Set oOutlookMail = oOutlookApp.CreateItem(0)
    
    Wb2.SaveAs sFilePath & sFilename & sFileExtension, FileFormat:=xFormat
    
    sMailBody = "Please keep a copy for yourself or CC yourself on this email." & vbNewLine & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
        "Snow Camp - " & vbNewLine & _
        "Mountain Camp - " & vbNewLine & _
        "Privates & Adults - " & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "Thank you for submitting your schedule."
    
    With oOutlookMail
        
        .To = sMe & "@vail.com"
        
        .CC = sSnowCampManager & "@vail.com;" & sMountainCampManager & "@vail.com;" & PrivatesAndAdultsManager & "@vail.com"
        
        .BCC = ""
        
        .Subject = "SRS 2023-24 Schedule"
        
        .Body = sMailBody
        
        On Error Resume Next '<= second occurrence. Why do you need this?
        
        .Attachments.Add Wb2.FullName
        
        .Display 'or use .Send
    
    End With
    
    Wb2.Close
    
'   You will not use the workbook again? This deletes it, obviously I guess.
    Kill sFilePath & sFilename & sFileExtension
    
    Set oOutlookApp = Nothing
    
    Set oOutlookMail = Nothing
    
    Application.ScreenUpdating = True

End Sub

sdmcavoy · Apr 10, 2023

OaklandJim said:

It would be helpful if you could post the workbook as a link using Box, Dropbox or 1Drive. Otherwise someone attempting to assist may have to create a mock-up workbook with fake data -- which is unlikely -- or there is no way to test code.

Here is an edited version of your code. NOT TESTED! I started there for readability with some comments and questions.

VBA Code:

Option Explicit '<= this forces declaration of all variables before they can be used.

'Is sub this in a worksheet's code module, hence the Private designation?
'It seems better to have it in a regular code module. And maybe give it a descriptive
'name such as Sub SendmailToManagers(). Right click your button to "Assign Macro" to it.

Private Sub CommandButton1_Click()

'   Ideally you declare all variables used.

    Dim xOutlookObj As Object  '<= not used
   
    Dim xOutApp As Object '<= not used
   
    Dim xOutMail As Object '<= not used
   
    Dim oOutlookApp As Object
   
    Dim oOutlookMail As Object
   
    Dim sMailBody As String
   
    Dim Wb As Workbook
   
    Dim Wb2 As Workbook
   
    Dim xFormat As Variant
   
    Dim sFilePath As String

    Dim sFilename As String
   
    Dim sFileExtension As String
   
'   Declaring recipients like this makes it easier to change them if a manager changes.
    Dim sMe As String

    Dim sSnowCampManager As String

    Dim sMountainCampManager As String

    Dim PrivatesAndAdultsManager As String

'   Set names for recipients.
    sMe = "Bob"

    sSnowCampManager = "Tamika"

    sMountainCampManager = "Jalen"

    PrivatesAndAdultsManager = "Zack"
   
'   Ideally you make sparing use of this. Why is it here? Where does code choke?
    On Error Resume Next

    Set Wb = Application.ActiveWorkbook
   
    ActiveSheet.Copy "<= What is this for?"
   
    Set Wb2 = Application.ActiveWorkbook 'Wb and Wb2 are the same? Do you NEED both?

'   So the workbook to be sent is NOT always the same type? Otherwise this seems unnecessay?
    Select Case Wb.FileFormat
   
    Case xlOpenXMLWorkbook: '<= do you ever send this type of workbook?
       
        sFileExtension = ".xls"
        'x "" <= this will cause an error
        xFormat = xlOpenXMLWorkbook
   
    Case xlOpenXMLWorkbookMacroEnabled:
   
        If Wb2.HasVBProject Then
            sFileExtension = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            sFileExtension = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
   
    Case Excel8:
   
        sFileExtension = ".xls" '<= do you ever send this type of workbook?
        xFormat = Excel8
   
    Case xlExcel12:  '<= do you ever send this type of workbook?
   
        sFileExtension = ".xlsb"
        xFormat = xlExcel12
   
    End Select

    sFilePath = Environ$("temp") & "\"

    sFilename = Wb.Name & Format(Now, "dd-mmm-yy")
   
    Set oOutlookApp = CreateObject("Outlook.Application")
   
    Set oOutlookMail = oOutlookApp.CreateItem(0)
   
    Wb2.SaveAs sFilePath & sFilename & sFileExtension, FileFormat:=xFormat
   
    sMailBody = "Please keep a copy for yourself or CC yourself on this email." & vbNewLine & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
        "Snow Camp - " & vbNewLine & _
        "Mountain Camp - " & vbNewLine & _
        "Privates & Adults - " & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "Thank you for submitting your schedule."
   
    With oOutlookMail
       
        .To = sMe & "@vail.com"
       
        .CC = sSnowCampManager & "@vail.com;" & sMountainCampManager & "@vail.com;" & PrivatesAndAdultsManager & "@vail.com"
       
        .BCC = ""
       
        .Subject = "SRS 2023-24 Schedule"
       
        .Body = sMailBody
       
        On Error Resume Next '<= second occurrence. Why do you need this?
       
        .Attachments.Add Wb2.FullName
       
        .Display 'or use .Send
   
    End With
   
    Wb2.Close
   
'   You will not use the workbook again? This deletes it, obviously I guess.
    Kill sFilePath & sFilename & sFileExtension
   
    Set oOutlookApp = Nothing
   
    Set oOutlookMail = Nothing
   
    Application.ScreenUpdating = True

End Sub

Sorry. I didn't realize I could upload it which is why I took screenshots. Honestly, I copied the code from a YouTube vid and altered with my info so a lot of your questions. I have a lot of answers.
Here's what I came up with

Option Explicit
.Range(P2).Value
ifwb.has "Snow Camp (3-6)" = sSnowCampManager
ifwb.has "Mountain Camp (7-14)" = sMountainCampManager
ifwb.has "Privates & Adults (13+)" = sPrivatesAndAdultsManager

Private Sub CommandButton1_Click()
Dim oOutlookApp As Object
Dim oOutlookMail As Object
Dim sMailBody As String
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim xFormat As Variant
Dim sFilePath As String
Dim sFilename As String
Dim sFileExtension As String
Dim sMe As String
Dim sSnowCampManager As String
Dim sMountainCampManager As String
Dim PrivatesAndAdultsManager As String
sMe = "Shannon"
sSnowCampManager = "Melissa"
sMountainCampManager = "Doug"
PrivatesAndAdultsManager = "Dave"
Set Wb = Application.ActiveWorkbook
sFileExtension = ".xls"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
sFileExtension = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
sFileExtension = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If

End Select
sFilePath = Environ$("temp") & "\"
sFilename = Wb.Name & Format(Now, "dd-mmm-yy")
Set oOutlookApp = CreateObject("Outlook.Application")
Set oOutlookMail = oOutlookApp.CreateItem(0)
Wb2.SaveAs sFilePath & sFilename & sFileExtension, FileFormat:=xFormat
sMailBody = "Please be sure to save a copy of your schedule for reference." & vbNewLine & vbNewLine & _
"" & vbNewLine & vbNewLine & _
"You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
"Snow Camp - Melissa.S.Evans@VailResorts.com" & vbNewLine & _
"Mountain Camp - Douglas.S.Kaufman@VailResorts.com" & vbNewLine & _
"Privates & Adults - David.Isaacs@VailResorts.com" & vbNewLine & _
"" & vbNewLine & vbNewLine & _
"Thank you for submitting your schedule. Rehire weekend is November 4th & 5th." & vbNewLine & _
"" & vbNewLine & _
"***Think Snow***"

With oOutlookMail
.To = sMe & "shannon.d.mcavoy@vailresorts.com"
.CC = sSnowCampManager & "Melissa.S.Evans@VailResorts.com;" & sMountainCampManager & "Douglas.S.Kaufman@VailResorts.com;" & PrivatesAndAdultsManager & "David.Isaacs@VailResorts.com"; & Range("k7").Value
.BCC = ""
.Subject = "2023-24 Schedule - " & Range("E3").Value
.Body = sMailBody
.Attachments.Add Wb2.FullName
.Display 'or use .Send
End With
Wb2.Close
Set oOutlookApp = Nothing
Set oOutlookMail = Nothing
Application.ScreenUpdating = True
End Sub

LINK TO SPREADSHEET: https://vailresorts-my.sharepoint.c...ZNoit-6z_H66oBfVBhpsA-cy5yrEWQ55V0zA?e=Kaor7k

sdmcavoy · Apr 10, 2023

OaklandJim said:

It would be helpful if you could post the workbook as a link using Box, Dropbox or 1Drive. Otherwise someone attempting to assist may have to create a mock-up workbook with fake data -- which is unlikely -- or there is no way to test code.

Here is an edited version of your code. NOT TESTED! I started there for readability with some comments and questions.

VBA Code:

Option Explicit '<= this forces declaration of all variables before they can be used.

'Is sub this in a worksheet's code module, hence the Private designation?
'It seems better to have it in a regular code module. And maybe give it a descriptive
'name such as Sub SendmailToManagers(). Right click your button to "Assign Macro" to it.

Private Sub CommandButton1_Click()

'   Ideally you declare all variables used.

    Dim xOutlookObj As Object  '<= not used
   
    Dim xOutApp As Object '<= not used
   
    Dim xOutMail As Object '<= not used
   
    Dim oOutlookApp As Object
   
    Dim oOutlookMail As Object
   
    Dim sMailBody As String
   
    Dim Wb As Workbook
   
    Dim Wb2 As Workbook
   
    Dim xFormat As Variant
   
    Dim sFilePath As String

    Dim sFilename As String
   
    Dim sFileExtension As String
   
'   Declaring recipients like this makes it easier to change them if a manager changes.
    Dim sMe As String

    Dim sSnowCampManager As String

    Dim sMountainCampManager As String

    Dim PrivatesAndAdultsManager As String

'   Set names for recipients.
    sMe = "Bob"

    sSnowCampManager = "Tamika"

    sMountainCampManager = "Jalen"

    PrivatesAndAdultsManager = "Zack"
   
'   Ideally you make sparing use of this. Why is it here? Where does code choke?
    On Error Resume Next

    Set Wb = Application.ActiveWorkbook
   
    ActiveSheet.Copy "<= What is this for?"
   
    Set Wb2 = Application.ActiveWorkbook 'Wb and Wb2 are the same? Do you NEED both?

'   So the workbook to be sent is NOT always the same type? Otherwise this seems unnecessay?
    Select Case Wb.FileFormat
   
    Case xlOpenXMLWorkbook: '<= do you ever send this type of workbook?
       
        sFileExtension = ".xls"
        'x "" <= this will cause an error
        xFormat = xlOpenXMLWorkbook
   
    Case xlOpenXMLWorkbookMacroEnabled:
   
        If Wb2.HasVBProject Then
            sFileExtension = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            sFileExtension = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
   
    Case Excel8:
   
        sFileExtension = ".xls" '<= do you ever send this type of workbook?
        xFormat = Excel8
   
    Case xlExcel12:  '<= do you ever send this type of workbook?
   
        sFileExtension = ".xlsb"
        xFormat = xlExcel12
   
    End Select

    sFilePath = Environ$("temp") & "\"

    sFilename = Wb.Name & Format(Now, "dd-mmm-yy")
   
    Set oOutlookApp = CreateObject("Outlook.Application")
   
    Set oOutlookMail = oOutlookApp.CreateItem(0)
   
    Wb2.SaveAs sFilePath & sFilename & sFileExtension, FileFormat:=xFormat
   
    sMailBody = "Please keep a copy for yourself or CC yourself on this email." & vbNewLine & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
        "Snow Camp - " & vbNewLine & _
        "Mountain Camp - " & vbNewLine & _
        "Privates & Adults - " & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "Thank you for submitting your schedule."
   
    With oOutlookMail
       
        .To = sMe & "@vail.com"
       
        .CC = sSnowCampManager & "@vail.com;" & sMountainCampManager & "@vail.com;" & PrivatesAndAdultsManager & "@vail.com"
       
        .BCC = ""
       
        .Subject = "SRS 2023-24 Schedule"
       
        .Body = sMailBody
       
        On Error Resume Next '<= second occurrence. Why do you need this?
       
        .Attachments.Add Wb2.FullName
       
        .Display 'or use .Send
   
    End With
   
    Wb2.Close
   
'   You will not use the workbook again? This deletes it, obviously I guess.
    Kill sFilePath & sFilename & sFileExtension
   
    Set oOutlookApp = Nothing
   
    Set oOutlookMail = Nothing
   
    Application.ScreenUpdating = True

End Sub

Note: I was able to figure out the last name in the subject line. I was not able to get the new code to work.

sdmcavoy · Feb 24, 2024

OaklandJim said:

It would be helpful if you could post the workbook as a link using Box, Dropbox or 1Drive. Otherwise someone attempting to assist may have to create a mock-up workbook with fake data -- which is unlikely -- or there is no way to test code.

Here is an edited version of your code. NOT TESTED! I started there for readability with some comments and questions.

VBA Code:

Option Explicit '<= this forces declaration of all variables before they can be used.

'Is sub this in a worksheet's code module, hence the Private designation?
'It seems better to have it in a regular code module. And maybe give it a descriptive
'name such as Sub SendmailToManagers(). Right click your button to "Assign Macro" to it.

Private Sub CommandButton1_Click()

'   Ideally you declare all variables used.

    Dim xOutlookObj As Object  '<= not used
   
    Dim xOutApp As Object '<= not used
   
    Dim xOutMail As Object '<= not used
   
    Dim oOutlookApp As Object
   
    Dim oOutlookMail As Object
   
    Dim sMailBody As String
   
    Dim Wb As Workbook
   
    Dim Wb2 As Workbook
   
    Dim xFormat As Variant
   
    Dim sFilePath As String

    Dim sFilename As String
   
    Dim sFileExtension As String
   
'   Declaring recipients like this makes it easier to change them if a manager changes.
    Dim sMe As String

    Dim sSnowCampManager As String

    Dim sMountainCampManager As String

    Dim PrivatesAndAdultsManager As String

'   Set names for recipients.
    sMe = "Bob"

    sSnowCampManager = "Tamika"

    sMountainCampManager = "Jalen"

    PrivatesAndAdultsManager = "Zack"
   
'   Ideally you make sparing use of this. Why is it here? Where does code choke?
    On Error Resume Next

    Set Wb = Application.ActiveWorkbook
   
    ActiveSheet.Copy "<= What is this for?"
   
    Set Wb2 = Application.ActiveWorkbook 'Wb and Wb2 are the same? Do you NEED both?

'   So the workbook to be sent is NOT always the same type? Otherwise this seems unnecessay?
    Select Case Wb.FileFormat
   
    Case xlOpenXMLWorkbook: '<= do you ever send this type of workbook?
       
        sFileExtension = ".xls"
        'x "" <= this will cause an error
        xFormat = xlOpenXMLWorkbook
   
    Case xlOpenXMLWorkbookMacroEnabled:
   
        If Wb2.HasVBProject Then
            sFileExtension = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            sFileExtension = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
   
    Case Excel8:
   
        sFileExtension = ".xls" '<= do you ever send this type of workbook?
        xFormat = Excel8
   
    Case xlExcel12:  '<= do you ever send this type of workbook?
   
        sFileExtension = ".xlsb"
        xFormat = xlExcel12
   
    End Select

    sFilePath = Environ$("temp") & "\"

    sFilename = Wb.Name & Format(Now, "dd-mmm-yy")
   
    Set oOutlookApp = CreateObject("Outlook.Application")
   
    Set oOutlookMail = oOutlookApp.CreateItem(0)
   
    Wb2.SaveAs sFilePath & sFilename & sFileExtension, FileFormat:=xFormat
   
    sMailBody = "Please keep a copy for yourself or CC yourself on this email." & vbNewLine & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
        "Snow Camp - " & vbNewLine & _
        "Mountain Camp - " & vbNewLine & _
        "Privates & Adults - " & vbNewLine & _
        "" & vbNewLine & vbNewLine & _
        "Thank you for submitting your schedule."
   
    With oOutlookMail
       
        .To = sMe & "@vail.com"
       
        .CC = sSnowCampManager & "@vail.com;" & sMountainCampManager & "@vail.com;" & PrivatesAndAdultsManager & "@vail.com"
       
        .BCC = ""
       
        .Subject = "SRS 2023-24 Schedule"
       
        .Body = sMailBody
       
        On Error Resume Next '<= second occurrence. Why do you need this?
       
        .Attachments.Add Wb2.FullName
       
        .Display 'or use .Send
   
    End With
   
    Wb2.Close
   
'   You will not use the workbook again? This deletes it, obviously I guess.
    Kill sFilePath & sFilename & sFileExtension
   
    Set oOutlookApp = Nothing
   
    Set oOutlookMail = Nothing
   
    Application.ScreenUpdating = True

End Sub

Hi again -
This code worked well! I had some complaints that people couldn't hit submit because they didn't have Excel or were on Mac. I just had them print to PDF and email it back.

I want to add a line that can target cell P2 which is their work area designation and have the submit button email that specific manager. The dropdown menu is "Private & Adults (13+)" Mountain Camp (7-14), and "Snow Camp (3-6)". Based on the answer from the employee, I'd like the email to go to that specific manager. How would I write that in? **code as written currently BELOW**

Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
Filename = Wb.Name & Format(Now, "dd-mmm-yy")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & Filename & xFile, FileFormat:=xFormat
With OutlookMail
.To = "DiscoveryCenterRentals@vailresorts.com"
.CC = "melissa.s.evans@vailresorts.com;douglas.s.kaufman@vailresorts.com;David.Isaacs@vailresorts.com;" & Range("k7").Value
.BCC = ""
.Subject = "2024-25 Schedule - " & Range("E3").Value
.Body = "Please be sure to save a copy of your schedule for reference." & vbNewLine & _
"" & vbNewLine & _
"You can reach out to your Core Area manager after October 1st:" & vbNewLine & _
"**Snow Camp - Melissa.S.Evans@VailResorts.com" & vbNewLine & _
"**Mountain Camp - Douglas.S.Kaufman@VailResorts.com" & vbNewLine & _
"**Privates & Adults - David.Isaacs@VailResorts.com" & vbNewLine & _
"" & vbNewLine & _
"Thank you for submitting your schedule. Rehire weekend is November 2nd & 3rd." & vbNewLine & _
"" & vbNewLine & _
"***Think Snow***"
On Error Resume Next
.Attachments.Add Wb2.FullName
.Display 'or use .Send
End With
Wb2.Close
Kill FilePath & Filename & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

Can I use VBA based on Cell Validation?

sdmcavoy

New Member

Attachments

Excel Facts

OaklandJim

Well-known Member

sdmcavoy

New Member

sdmcavoy

New Member

sdmcavoy

New Member

Similar threads

Forum statistics

Share this page

Can I use VBA based on Cell Validation?

sdmcavoy

New Member

Attachments

Excel Facts

OaklandJim

Well-known Member

sdmcavoy

New Member

sdmcavoy

New Member

sdmcavoy

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock