Worksheet Change Event

[Jammydan]

Hi

I have a spreadsheet which a user answers a number of questions and then it emails the selected approver to approve. It all works great other than the code only works when the approver opens it if Excel is closed beforehand. If excel is already open the code doesn't run?

I can a attach the code if necessary but wandered if anybody has any ideas?

Many thanks
Dan

 

[VoG]

Can you post the code.

 

[Jammydan]

Dim Cell As Range
Dim SelectDG As Range
Dim UserDG As Range
Dim EmailA As Range
Dim EmailM As Range
Dim EmailB As Range
Dim PrintDG As Range
Dim ESD As Range
Dim Msg As String
Private Sub Worksheet_Change(ByVal Target As Range)
Set SelectDG = Range("G10:G120")
Set UserDG = Range("L2")
Set EmailA = Range("H21")
Set EmailM = Range("H20")
Set EmailB = Range("H55")
Set PrintDG = Range("H100")
Set ESD = Range("G14")
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
'**** EMAIL ****
If EmailM <> "Please Select" And EmailA = "Please Select" Then
    Rows("21").EntireRow.Hidden = False
    EmailA = "Approve/Decline"
       Application.Run "EmailManager"
       Application.WindowState = xlMinimized
       ActiveWorkbook.Close savechanges:=False
End If
    If EmailA = "Approved" And EmailM = UserDG Then
        Rows("22").EntireRow.Hidden = False
        Rows("23").EntireRow.Hidden = True
        Rows("70:90").EntireRow.Hidden = True
        Application.Run "EmailBusiness"
        Application.WindowState = xlMinimized
        ActiveWorkbook.Close savechanges:=False
    ElseIf EmailA = "Rejected" And EmailM = UserDG Then
        Rows("33").EntireRow.Hidden = True
        Rows("23").EntireRow.Hidden = False
        Application.Run "EmailRM"
        Application.WindowState = xlMinimized
       ActiveWorkbook.Close savechanges:=False
    ElseIf EmailA = "Please Select" And EmailM <> "Please Select" Then
        Rows("22").EntireRow.Hidden = True
    Else: Rows("23:23").EntireRow.Hidden = True
End If
If EmailB <> "Please Select" Then
    Rows("40:60").EntireRow.Hidden = True
    Rows("70:90").EntireRow.Hidden = False
    EmailB = "Please Select"
    Application.Run "EmailRM"
    Application.WindowState = xlMinimized
    ActiveWorkbook.Close savechanges:=False
End If
'**** "PLEASE SELECT" RANGE ****
For Each Cell In SelectDG
    If Cell.Value = "Please Select" Then
        Cell.Interior.ColorIndex = 36
        Cell.Offset(0, 1) = ""
    ElseIf Cell.Value = "Yes" And Cell.Offset(0, 1) = "" Then
        Cell.Interior.ColorIndex = 2
        Cell.Offset(0, 1) = UserDG
    ElseIf Cell.Value = "No" And Cell.Offset(0, 1) = "" Then
        Cell.Interior.ColorIndex = 2
        Cell.Offset(0, 1) = UserDG
    ElseIf Cell.Value = "N/A" And Cell.Offset(0, 1) = "" Then
        Cell.Interior.ColorIndex = 2
        Cell.Offset(0, 1) = UserDG
    End If
Next
'**** CLIENT NAME ****
If Range("F6") <> "" Then
    Range("F6").Interior.ColorIndex = 2
    ElseIf Range("F6") = "" Then
    Range("F6").Interior.ColorIndex = 36
End If
 '**** ACCOUNT ****
If Range("F7") <> "" Then
    Range("F7").Interior.ColorIndex = 2
    ElseIf Range("F7") = "" Then
    Range("F7").Interior.ColorIndex = 36
End If
If Range("G7") <> "" Then
        Range("G7").Interior.ColorIndex = 2
    ElseIf Range("G7") = "" Then
        Range("G7").Interior.ColorIndex = 36
End If
If Range("H7") <> "" Then
        Range("H7").Interior.ColorIndex = 2
    ElseIf Range("H7") = "" Then
        Range("H7").Interior.ColorIndex = 36
End If
'**** ADDRESS TYPE ****
If Range("G12") = "Yes" And Range("G13") = "Yes" Then
        Range("B41") = "New Correspondence and Residential Address Updated"
        Range("B25") = "New Residential Address Updated"
        Range("F25:H30").Borders.LineStyle = xlContinuous
        Range("F25") = "New Correspondence Address Updated"
        Range("F25").Interior.ColorIndex = 43
        Rows("24:33").EntireRow.Hidden = False
    ElseIf Range("G12") = "Yes" Then
        Range("B25,B41") = "New Residential Address Updated"
        Range("F25") = ""
        Range("F25").Interior.ColorIndex = xlNone
            With Range("E24:H31")
                .Borders.LineStyle = xlNone
                .ClearContents
            End With
            Rows("24:33").EntireRow.Hidden = False
    ElseIf Range("G13") = "Yes" Then
        Range("B25,B41") = "New Correspondence Address Updated"
        Range("F25") = ""
        Range("F25").Interior.ColorIndex = xlNone
            With Range("E24:H31")
                .Borders.LineStyle = xlNone
                .ClearContents
            End With
            Rows("24:33").EntireRow.Hidden = False
    Else: Range("B25,F25,B41") = ""
    Rows("24:33").EntireRow.Hidden = True
End If
    
'**** EUSTD ****
If ESD = "N/A" Then
        Rows("82:87").EntireRow.Hidden = True
    ElseIf ESD = "Yes" And Range("G71") <> "Please Select" Then
        Rows("82:87").EntireRow.Hidden = False
End If
    
'**** PRINT ****
If PrintDG = "Print" And ESD = "N/A" Then
    Rows("39:90").EntireRow.Hidden = False
    Rows("57:69").EntireRow.Hidden = True
    Rows("43").EntireRow.Hidden = True
    Rows("82:87").EntireRow.Hidden = True
        Application.Dialogs(xlDialogPrint).Show
        PrintDG = "Please Select"
            ActiveWorkbook.SaveAs Filename:= _
            "G:\Private Banking\Central Information\Address Changes\" _
            & Range("F6") & " Address " & Format(Now, "mmmyy") & FileExtStr
ElseIf PrintDG = "Print" And ESD <> "N/A" Then
    Rows("39:90").EntireRow.Hidden = False
    Rows("57:69").EntireRow.Hidden = True
    Application.Dialogs(xlDialogPrint).Show
    PrintDG = "Please Select"
    ActiveWorkbook.SaveAs Filename:= _
    "G:\Test\Address\Address Changes\" _
    & Range("F6") & " Address " & Format(Now, "mmmyy") & FileExtStr
End If
    ActiveSheet.Protect
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[VoG]

For example here

If EmailM <> "Please Select" And EmailA = "Please Select" Then
    Rows("21").EntireRow.Hidden = False
    EmailA = "Approve/Decline"
       Application.Run "EmailManager"
       Application.WindowState = xlMinimized
       ActiveWorkbook.Close savechanges:=False

events are disabled. You need to re-enable events before closing the workbook.

 

[Jammydan]

Thanks, that's great!

Do you know why it worked if you reopen Excel though?

 

[VoG]

Closing then re-opening Excel sets events to enabled.