Stop automatic Macro from running

[purpleozzie]

Hi guys,

I have a spreadsheet for work that is essentially a price list for reps.. When they open the spreadsheet it automatically populates their email name and telephone number by checking their computer name against a hidden worksheet called 'users' and pulling the info from their, as per below macro

Private Sub workbook_open()

    Dim User As Variant
    Dim UsersName As String, Userssurname As String
    Dim rng As Range
    Dim wsUsers As Worksheet, wsPrices As Worksheet
    
    With ThisWorkbook
        
        
        
        Set wsUsers = Worksheets("Users")
        Set wsPrices = Sheet1
    End With
    
    Set rng = wsUsers.Range("C1:C" & wsUsers.Cells(wsUsers.Rows.Count, "C").End(xlUp).Row)
    
    User = Application.Match(Environ("Computername"), rng, False)
    
    If Not IsError(User) Then
    
    UsersName = wsUsers.Cells(CLng(User), 1).Value
    Userssurname = wsUsers.Cells(CLng(User), 2).Value
    End If
    
    With wsPrices
        .Range("B4").Value = UsersName & " " & Userssurname
        .Range("B6").Value = wsUsers.Cells(CLng(User), 4).Value
        .Range("E6").Value = wsUsers.Cells(CLng(User), 5).Value
    End With
End Sub

Then the rep fills in proposed prices and clicks on a button called 'send for approval' which saves, and emails the quote to the boss..

Sub APPROVAL()   
  
     Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim FileExt As String
    Dim TempFileName As String
    Dim FileFullPath As String
    Dim MyWb As Workbook
    Dim rangeTemp As Range
  
   Call OptimizeCode_Begin
  If Range("B5") <> "" Then


 Sheets("old prices").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheet1.Select


Set rngTemp = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not rngTemp Is Nothing Then
    Range(Cells(1, 1), rngTemp).AutoFilter Field:=8, Criteria1:="<>"
End If
  
    Set MyWb = ThisWorkbook
      
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
      
       Range("E6:H6").Select
    Selection.Copy
    Range("P1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("P1").Select
      
      
    TempFilePath = Environ$("temp") & "\"
    FileExt = "." & LCase(Right(MyWb.Name, Len(MyWb.Name) - InStrRev(MyWb.Name, ".", , 1)))
    
    TempFileName = Sheet1.Range("B5").Text & " - " & "SDA" & " - " & Format(Now, "dd-mmm-yy")
 
    FileFullPath = TempFilePath & TempFileName & FileExt
     
    MyWb.SaveCopyAs FileFullPath
     
    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)
     
    On Error Resume Next
    With NewMail
        .To = "simon@amathusdrinks.com"
        .Subject = "SDA - " & Range("B5")
        .Body = Range("B5") & " - " & Range("B8")
        .Attachments.Add FileFullPath '--- full path of the temp file where it is saved
        .Display
    End With
    On Error GoTo 0
          
    Kill FileFullPath
      
    Set NewMail = Nothing
    Set OlApp = Nothing
      
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   Call OptimizeCode_End
   
Else
MsgBox "Please fill in Customer Name"
Exit Sub
End If


End Sub

The boss then opens it and if he's happy, he clicks 'approved', another macros runs and the spreadsheet gets emailed back to the rep.. However, when the boss opens the spreadsheet it automatically changes the users details to him, which means when it tries to email it back to the rep it's pulling the boss's email address off as the recipients..

Is there a way of when 'Send for Approval' is clicked that the users name, email address and telephone number are cemented into place.. I'm thinking something that will stop the initial macro from running next time the spreadsheet is opened.. I'm assuming it's just one line of extra code needed but I can't find ny help on google to give me an answer.

Cheers,

B

 

[daverunt]

Can you not write the last users details to the hidden spread sheet in a separate location when 'Send for Approval' is clicked.
When 'Approved' is clicked on the bosses machine then enter the recipients details from that location and erases it when the mail is sent?