Worksheet Change Event

[Fergus]

Based on what I have culled from various posts on the Board I am trying to write a code to make a workbook save itself under a new name and then clear the contents of some cells. I want it to do this every time the contents of one cell are changed. The changing of this cells' contents will also cause another cell to change and this latter cell will be used as the name for the newly saved workbook.

So far I have managed to get the code to work as a macro which I can initiate from the Tools menu, but when I try to make it a worksheet change event nothing happens.

Below is the code as far as I have managed to get it. Can anyone tell me why it's not working when the contents of cell L5 are changed.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$L$5" Then
    Application.EnableEvents = False
    Dim rng As Range, ac As Integer, dn As Integer, i As Integer
    Application.ScreenUpdating = False
    If Dir("D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls") = "" Then
        Set rng = Range("H12,Q36")
        dn = 1
        Do While dn < 25
        ac = 1
        Do While ac < 11
        rng.Cells(dn, ac).Value = ""
        ac = ac + 1
        Loop
        dn = dn + 1
        Loop
        ActiveWorkbook.SaveCopyAs Filename:="D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls"
        MsgBox "your new weekly Muster has just been saved!"
        Workbooks.Open "D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls", 3
        Workbooks(1).Activate
        ActiveWorkbook.Close SaveChanges:=False
        Exit Sub
        Else
        i = MsgBox("Overwrite existing file...?", vbYesNo)
        Application.DisplayAlerts = False
        If i = 6 Then
            ActiveWorkbook.Save
            Workbooks.Open "D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls", 3
            Workbooks(1).Activate
            ActiveWorkbook.Close SaveChanges:=False
            Else
            MsgBox "Then you need to enter a new week start date"
            Exit Sub
        End If
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Any help will be most gratefully received.

 

[cherria]

Was the code in a worksheet module rather than a general module?

A worksheet_change procedure needs to be in a worksheet module.

right click on the worksheet tab and select view code, then paste it into here.

 

[Fergus]

Hi Cherria,

Code's in the Worksheet module already.

 

[macleanb]

Have you debugged? with what result?

 

[Fergus]

In it's present form, as a Private Sub Worksheet_Change(ByVal Target As Range) I can't get it to de-bug, don't know why.

If I change the first few lines to:

Option Explicit
Sub newname()

'Private Sub Worksheet_Change(ByVal Target As Range)
'If Target.Address = ("$L$5,$N$5") Then

and comment-out the final "End If" it works fine, both when initiated from Tools > Macro >Macros and when I try to de-bug it.

 

[macleanb]

sounds like enableevents is off - create a seperate button to set it to true & try again

 

[macleanb]

I have fallen into this trap myself - I notice you have exit subs where there is no correspondion enableevents = true

 

[Fergus]

Hi Ben,

Thanks for your input. I had noticed that between first posting and now and had already modified the code to set enableevent back to true before each of the Exit Subs, code currently looks like:

Option Explicit
'Sub newname()

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$L$5" Then
    Application.EnableEvents = False
    Dim rng As Range, ac As Integer, dn As Integer, i As Integer
    Application.ScreenUpdating = False
    If Dir("D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls") = "" Then
        Set rng = Range("H12,Q36")
        dn = 1
        Do While dn < 25
        ac = 1
        Do While ac < 11
        rng.Cells(dn, ac).Value = ""
        ac = ac + 1
        Loop
        dn = dn + 1
        Loop
        ActiveWorkbook.SaveCopyAs Filename:="D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls"
        MsgBox "your new weekly Muster has just been saved!"
        Workbooks.Open "D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls", 3
        Workbooks(1).Activate
        ActiveWorkbook.Close SaveChanges:=False
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
        Else
        i = MsgBox("Overwrite existing file...?", vbYesNo)
        Application.DisplayAlerts = False
        If i = 6 Then
            ActiveWorkbook.Save
            Workbooks.Open "D:\My Data\Test Bed Excel\" & "Muster_" & [R5].Value & ".xls", 3
            Workbooks(1).Activate
            ActiveWorkbook.Close SaveChanges:=False
            Else
            MsgBox "Then you need to enter a new week start date"
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            Exit Sub
        End If
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

But it still won't work as a change event.

 

[macleanb]

but did you "fix" the current state of enable events?

 

[Fergus]

Hi Ben,

No, you're right, I didn't. But after reading your comment, and not knowing any other way to "fix" it I closed Excel and then re-opened and it worked !! but only once !! I thought by adding "Application.EnableEvents = True" before each possible exit I would have solved it, but it seems not. Any more ideas, vba is not my strong point.