Approve / Reject Message Box

[jrtdcg]

Hello,

All, I have a macro built for my managers allowing them to run the macro from their workstation to review employee spreadsheets. It all works good, but it's missing that final piece. Long story short, it's an approval process for there employees. Just curious if their is a way to have the code:

1. Bring up a comment box asking if the spreadsheet is approved or rejected
2. If approved, putting an electronic signature into the approved cell with date stamp
3. If rejected, putting in an electronic signature into the rejected cell with date stamp

Hope this was clear enough. Please let me know if I can provide further details.

Thank you in advance...J.R.

 

[mrmmickle1]

Try something like this:

[COLOR=#0000ff]Sub [/COLOR]ApproveRejectPrompt()

    [COLOR=#0000ff]Dim[/COLOR] ApprRejQues [COLOR=#0000ff]As String[/COLOR]
    
    ApprRejQues = Application.InputBox(Prompt:="If Approved Then Type 1 if Rejected Type 2", Title:="Student Grade Approval", Type:=2)
   [COLOR=#0000ff] If [/COLOR]ApprRejQues = "" [COLOR=#0000ff]Then Exit Sub[/COLOR]
    
  [COLOR=#0000ff]  If[/COLOR] ApprRejQues = "1" [COLOR=#0000ff]Then[/COLOR]
         Range("A1").Value = "APPROVED My Signature " & Format(Now(), "yyyy-MM-dd hh:mm:ss")
   [COLOR=#0000ff] ElseIf[/COLOR] ApprRejQues = "2" [COLOR=#0000ff]Then[/COLOR]
         Range("A1").Value = "REJECTED My Signature " & Format(Now(), "yyyy-MM-dd hh:mm:ss")
 [COLOR=#0000ff]   Else[/COLOR]
         MsgBox "Please Select a Valid Option", vbCritical, "Student Grade Approval"
  [COLOR=#0000ff]  End If
 
End Sub[/COLOR]

 

[jrtdcg]

Thanks for the quick reply. The code works great, but is there a way to put a in just a message box with the Do you approve or reject question and "Approved" and "Rejected" buttons on the box, rather then have to type in the input box?
Thanks for being patient with my novice questions....

 

[mrmmickle1]

What About This:

[COLOR=#0000ff]Sub[/COLOR] ApproveRejectPrompt()

   [COLOR=#0000ff] Dim [/COLOR]ApprRejQues[COLOR=#0000ff] As String[/COLOR]
    
    ApprRejQues = MsgBox("If Approved Then Select Yes If Not Approved Select No", vbYesNo, "Student Grade Approval")
    
        [COLOR=#0000ff] If [/COLOR]ApprRejQues = vbYes [COLOR=#0000ff]Then[/COLOR]
               Range("A1").Value = "APPROVED My Signature " & Format(Now(), "yyyy-MM-dd hh:mm:ss")
[COLOR=#0000ff]         Else[/COLOR]
               Range("A1").Value = "REJECTED My Signature " & Format(Now(), "yyyy-MM-dd hh:mm:ss")
[COLOR=#0000ff]         End If[/COLOR]
 
[COLOR=#0000ff]End Sub[/COLOR]

If you really need the buttons to say specific things like "Approved" or "Rejected" you will need to construct a simple userform.

 

[jrtdcg]

Perfect! Thank you very much for your help.

J.R.

 

[Rick Rothstein]

If you really need the buttons to say specific things like "Approved" or "Rejected" you will need to construct a simple userform.

While the UserForm would be more desirable, it is not the only option. You could also use an "old-time" dialog sheet" as well. Put this in a General Module (same place macros go)...

Function ApproveRejectButton() As Long
  Const SheetID As String = "_Buttonz"
  Dim btnDlg As DialogSheet
   
  Application.ScreenUpdating = False
  On Error Resume Next
  Application.DisplayAlerts = False
  ActiveWorkbook.DialogSheets(SheetID).Delete
  Application.DisplayAlerts = True
  Err.Clear
   
  Set btnDlg = ActiveWorkbook.DialogSheets.Add
   
  With btnDlg
    .Name = SheetID
    .Visible = xlSheetHidden
     
    With .DialogFrame
      .Height = 55
      .Width = 265
      .Caption = "Approve Or Reject Spreadsheet"
    End With
     
    With .Buttons("Button 2")
      .BringToFront
      .Left = 190
      .Top = 42
      .Height = 25
      .Width = 60
      .Caption = "Approve"
    End With
     
    With .Buttons("Button 3")
      .BringToFront
      .Left = 260
      .Top = 42
      .Height = 25
      .Width = 60
      .Caption = "Reject"
    End With
     
    .Labels.Add 80, 40, 100, 60
    .Labels(1).Caption = "Do you want to approve or reject this spreadsheet?"
    Application.ScreenUpdating = True
    
    If .Show = True Then
      ApproveRejectButton = 1
    Else
      ApproveRejectButton = 0
    End If
     
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
   
  End With
End Function

Then call it from within your own code like this...

If ApproveRejectButton = 1 then
  ' Approve button code goes here
Else
  ' Reject button code goes here
End If

Note: The ApproveRejectButton function returns 1 if the Approve button was clicked and 0 if the Reject button or red X in upper right corner was pressed.

 

[mrmmickle1]

Rick,

What a gem! Thanks for that. I'm definitely filing that away! I didn't know that was possible.

jrtdcg,

Your welcome. I would probably use Rick's Code for this little task. His solution is a little more polished.


Just Curious....What does the SheetID accomplish?

What about this last little portion too?:

    If .Show = True Then
      ApproveRejectButton = 1
    Else
      ApproveRejectButton = 0
    End If
     
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
   
  End With
End Function

 

[jrtdcg]

Sorry for the slow response today. Thank you Rick for the added suggestions to my question. It might be a little more advanced then what I'm used to working with, but I'm always willing to learn and try something new. I too have to ask the same questions about the second code portion. I placed the first code in a new module as suggested, took the lower code and placed in with the macro (different module) that I'm running, but was a little lost after that point.
Love to see this work, just wish I more fluent in the code world.

Thanks again!

 

[amralomari]

Hi and happy holidays

can we make it send an email, save the document as read-only and, if possible, add a watermark when it's approved?
And send an email when it's Rejected???

Thanks in advance