Worksheet Change Dropdown Works Once

[neomapper1]

I have a script that runs an action change based on AA3 when a change occurs but it only works once. How would I keep running if I change the dropdown?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Path As String
Dim Filename As String

Dim Office As String
Dim HouseNo As String
Dim Street As String
Dim Unit As String
Dim URL As String
Dim CloudLancaster As String
Dim strInput As String
Dim Result As String
Dim InStr As String

Office = Range("AA3").Value
HouseNo = Range("A5").Value
Street = Range("G5").Value
Unit = Range("S5").Value

' Cloud Varibles
CloudLancaster = "https://link.egnyte.com/app/index.do#/"


If Not Intersect(Target, Range("AA3")) Is Nothing Then
    If InStr(1, Target.Value, "Lancaster") > 0 Then
        If Target <> olval Then
            Application.EnableEvents = False
            Filename = Format(Range("G4"), "[COLOR=#ff0000]dd-mm-yyyy[/COLOR]")
            olval = Filename
            Path = "Z:\Shared\Enterprise File Shares\NEO_Assignments\2021 Work Orders\1) Lancaster Office\0_Service_Request\"
                If IsEmpty(Range("S5").Value) = True Then
                    URL = Path & Office & " - " & HouseNo & " " & Filename
                    MkDir URL
                    ActiveWorkbook.SaveAs Filename:=URL & "\" & Office & " - " & HouseNo & " " & Filename & " " & ".xls"
                    strReplace = Office & " - " & HouseNo & " " & Filename
                    Result = Replace(strReplace, " ", "%20")
                    InputBox "Copy the link to Star", "Egnyte Link", CloudLancaster & Result
                Else
                    URL = Path & Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit
                    MkDir URL
                    ActiveWorkbook.SaveAs Filename:=URL & "\" & Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit & ".xls"
                    Application.EnableEvents = True
                    strReplace = Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit
                    Result = Replace(strReplace, " ", "%20")
                    InputBox "Copy the link to Star", "Egnyte Link", CloudLancaster & Result
                End If
        End If
    End If
End If
End Sub

 

[Joe4]

Welcome to the Board!

I think it is because of the location of this line:

Application.EnableEvents = True

If your code meets the first condition of your inner-most IF...THEN block, that line of code will not run, so events won't be re-enabled.

Try moving it in to the same IF... THEN block as the one that turns it off, i.e.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Path As String
Dim Filename As String

Dim Office As String
Dim HouseNo As String
Dim Street As String
Dim Unit As String
Dim URL As String
Dim CloudLancaster As String
Dim strInput As String
Dim Result As String
Dim InStr As String

Office = Range("AA3").Value
HouseNo = Range("A5").Value
Street = Range("G5").Value
Unit = Range("S5").Value

' Cloud Varibles
CloudLancaster = "https://link.egnyte.com/app/index.do#/"


If Not Intersect(Target, Range("AA3")) Is Nothing Then
    If InStr(1, Target.Value, "Lancaster") > 0 Then
        If Target <> olval Then
            Application.EnableEvents = False
            Filename = Format(Range("G4"), "[COLOR=#ff0000]dd-mm-yyyy[/COLOR]")
            olval = Filename
            Path = "Z:\Shared\Enterprise File Shares\NEO_Assignments\2021 Work Orders\1) Lancaster Office\0_Service_Request\"
                If IsEmpty(Range("S5").Value) = True Then
                    URL = Path & Office & " - " & HouseNo & " " & Filename
                    MkDir URL
                    ActiveWorkbook.SaveAs Filename:=URL & "\" & Office & " - " & HouseNo & " " & Filename & " " & ".xls"
                    strReplace = Office & " - " & HouseNo & " " & Filename
                    Result = Replace(strReplace, " ", "%20")
                    InputBox "Copy the link to Star", "Egnyte Link", CloudLancaster & Result
                Else
                    URL = Path & Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit
                    MkDir URL
                    ActiveWorkbook.SaveAs Filename:=URL & "\" & Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit & ".xls"
                    strReplace = Office & " - " & HouseNo & " " & Filename & " Unit# " & Unit
                    Result = Replace(strReplace, " ", "%20")
                    InputBox "Copy the link to Star", "Egnyte Link", CloudLancaster & Result
                End If
            Application.EnableEvents = True
        End If
    End If
End If
End Sub