Macro location problem?

[lmc_budd]

Hi,
Some time ago I added a macro to a single page worksheet (called Design). It causes excel pictures to turn on (or off) depending on the contents of a cell. (See below for macro). My problem is that if I have two or more worksheets open at once which contain this macro, then changing one worksheet affects all the others as well! I need each worksheet to be independent. How can I achieve this? Is the macro stored in the wrong place? (It's stored in Sheet 1 (Design) at present).

Private Sub Worksheet_Calculate()
If ActiveSheet.Range("F64") = "S" Or ActiveSheet.Range("F64") = "s" Then
Shapes("Picture 2").Visible = False
Shapes("Picture 1").Visible = True
End If
If ActiveSheet.Range("F64") = "D" Or ActiveSheet.Range("F64") = "d" Then
Shapes("Picture 1").Visible = False
Shapes("Picture 2").Visible = True
End If
If ActiveSheet.Range("H72") = "No Stiffeners Required" Then
Shapes("Picture 3").Visible = True
Else
Shapes("Picture 3").Visible = False
End If
End Sub

 

[Monkey]

Try something like:
if Activesheet.name = "Monkey.xls" then
your code
End if


or try to "play" with this (Sheet1 instead of Activesheet)

Sub monkey()
If Sheets("Sheet1").Range("A1") = "" Then
Sheets("Sheet1").Range("A1") = "1"
Else
Sheets("Sheet1").Range("A1") = ""
End If
End Sub

 

[lmc_budd]

Thanks for the suggestions, but I've had no luck in making them work.
Your first idea - if Activesheet.name = "Monkey.xls" then - might work if I could make the macro automatically substitute the filename, (as this can be literally any name, I can't predict it in advance.)
Your second idea seemed hopeful, but I was not successful with it. I tried moving it to the "ThisWorkbook" area, but then excel seemed to ignore it altogether.
I can't understand why the original macro doesn't work correctly, as it specifically refers to the activesheet, and only one can be active at a time!
Thanks again.

 

[anvil19]

Hi Imc_budd

How about something like this :

Private Sub TheWorkings(SheetName As WorkSheet)

    If SheetName.Range("F64") = UCase("S") Then
        Shapes("Picture 2").Visible = False
        Shapes("Picture 1").Visible = True
    End If

    If SheetName.Range("F64") = UCase("D") Then
        Shapes("Picture 1").Visible = False
        Shapes("Picture 2").Visible = True
    End If

    If SheetName.Range("H72") = "No Stiffeners Required" Then
        Shapes("Picture 3").Visible = True
    Else
        Shapes("Picture 3").Visible = False
    End If

End Sub

Sub Worksheet_Calculate()
    
    Dim xlWSheet As WorkSheet
    Set xlWSheet = Activesheet

    TheWorkings (xlWSheet)

End Sub

You place the TheWorkings() and the WorkSheet_Calculate() sub procedures into a module. Then call WorkSheet_Calculate() with a button on a toolobar.

Try That

anvil19

 

[lmc_budd]

Thanks for the input.
Sadly, this spreadsheet will need to be used by a nuber of people on different PC's, some of whom are not sufficiently computer-literate to install and deal with toolbar buttons! This really must be a self-contained process without any user intervention. Is there a way that your ideas could be modified to incorporate this?
Cheers,
Steve.

 

[just_jon]

The problem is your event -- on Calculate. When you force calculation, unless explicitlly limiting with Shift-F9 for instance, the underlying workbooks also get computed causing all such macros to fire. You could put in something like [ *untested* ] --

If ActiveWorkbook.Name <> ThisWorkbook.Name then Exit Sub


to see if that might work.

 

[anvil19]

Hey again

Add this code to a Module called Menu. It will add a menu option into Excel that would give any person that opens the spreadsheet a new menu between Window and Help.

Public Sub AddCustomMenubar()
Dim cbWSMenuBar As CommandBar
Dim muCustom As CommandBarControl
Dim iHelpIndex As Integer

Set cbWSMenuBar = CommandBars("Worksheet Menu Bar")
    iHelpIndex = cbWSMenuBar.Controls("Help").Index
        Set muCustom = cbWSMenuBar.Controls.Add(Type:=msoControlPopup, before:=iHelpIndex, Temporary:=True)

        With muCustom
            .Caption = "&WorkSheet _Calculate"
            With .Controls.Add(Type:=msoControlButton)
            .Caption = "Run the Worksheet_Calculate Macro"
            .OnAction = "WorkSheet_Calculate"
        End With
                
    End With

End Sub

Public Sub RemoveCustomMenuBar()
Dim cbWSMenuBar As CommandBar
On Error Resume Next
    Set cbWSMenuBar = CommandBars("Worksheet menu bar")
    cbWSMenuBar.Controls("WorkSheet _Calculate").Delete
End Sub

Add the following to ThisWorkBook.

Sub workbook_open()
     AddCustomMenubar
End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)
     RemoveCustomMenuBar
End Sub

Now every user will have the use of the macro as a menu option. The new menu option will load when you load this workbook, and will unload when you close the workbook.

Try That

anvil19


P.S The previous code has been altered to :

Private Sub TheWorkings(SheetName As Worksheet)

    Dim Shapes As Shape
    
    If SheetName.Range("F64") = UCase("S") Then
        Shapes("Picture 2").Visible = False
        Shapes("Picture 1").Visible = True
    End If

    If SheetName.Range("F64") = UCase("D") Then
        Shapes("Picture 1").Visible = False
        Shapes("Picture 2").Visible = True
    End If

    If SheetName.Range("H72").Value = "No Stiffeners Required" Then
        Shapes("Picture 3").Visible = True
    Else
        Shapes("Picture 3").Visible = False
    End If

End Sub

Sub Worksheet_Calculate()
    
    Dim xlWSheet As Worksheet
    Set xlWSheet = ActiveSheet

    TheWorkings xlWSheet

End Sub

 

[lmc_budd]

Great work, and thanks very much for your efforts. The spreadsheet displays the graphics in just one sheet perfectly now!