Good afternoon excel Gurus,

I currently have a macro button for when pressed it saves the excel sheet
and automatically sends emails to 2 other users in the company to say this
excel sheet is ready for review.

What i now need to happen is when the manager opens this excel sheet I am
going to create an 'Approval' button so when pressed is will say:

Are you sure you want to approve this PIP? Click yes, save as to a specific
location location detailing a cell reference B10 for the name of the file,
click no it will automatically reply to the person who submitted this excel
workbook saying plese review your PIP as it as been declined.

Below you will see my current code for this to work:

Sub save()

ActiveWorkbook.save

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

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

strbody = "PIP" & " for " & Sheets("PROFIT IMPROVEMENT
PLAN").Range("B10").Value & " " & _
Sheets("PROFIT IMPROVEMENT PLAN").Range("B11").Value & " " & "Ready For
Review"

On Error Resume Next
With OutMail
.To = ; "
.CC = ""
.BCC = ""
.Subject = "PIP Ready For Review"
.Body = strbody
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

try not to use KEYWORDS as sub or variables. So please change
SUB save() to
SUB Approve()
add the two sub (below) and associate ChooseApproveDecline with the button
Clicking the button will ask if you want to Approve, If YES, your original
code is called, if NO the you're asked if you want to decline and the
declined code (yours - just a few changes to the wording) gets sent

then add a Sub Decline
Sub Decline()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

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

strbody = "PIP" & " for " & Sheets("PROFIT IMPROVEMENT
PLAN").Range("B10").Value & " " & _
Sheets("PROFIT IMPROVEMENT PLAN").Range("B11").Value & " " & "Declined"

On Error Resume Next
With OutMail
.To = ; "
.CC = ""
.BCC = ""
.Subject = "PIP Declined"
.Body = strbody
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub



Add a new sub

SUB ChooseApproveDecline()
if msgbox("Do you want to Approve?,vbyesNo,"Approve PIP")= vbYes Then
Approve
elseif msgbox("Do you want to Decline?,vbyesNo,"Decline PIP")= vbYes Then
Decline
else
msgbox "Nothing sent"
end if
End Sub


"Neil Holden" wrote:

Good afternoon excel Gurus,

I currently have a macro button for when pressed it saves the excel sheet
and automatically sends emails to 2 other users in the company to say this
excel sheet is ready for review.

What i now need to happen is when the manager opens this excel sheet I am
going to create an 'Approval' button so when pressed is will say:

Are you sure you want to approve this PIP? Click yes, save as to a specific
location location detailing a cell reference B10 for the name of the file,
click no it will automatically reply to the person who submitted this excel
workbook saying plese review your PIP as it as been declined.

Below you will see my current code for this to work:

Sub save()

ActiveWorkbook.save

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

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

strbody = "PIP" & " for " & Sheets("PROFIT IMPROVEMENT
PLAN").Range("B10").Value & " " & _
Sheets("PROFIT IMPROVEMENT PLAN").Range("B11").Value & " " & "Ready For
Review"

On Error Resume Next
With OutMail
.To = ; "
.CC = ""
.BCC = ""
.Subject = "PIP Ready For Review"
.Body = strbody
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub