I don't want it to work

bluefeather8989 · Feb 26, 2011

I need to make a macro not to work if A1=1
the macro is attached to a shape and it someone double clicks it will run twice (that’s very BAD).

bluefeather8989 · Mar 13, 2011

jasonb75 said:
It works if you do it with screenupdating active, i.e

Rich (BB code):

ActiveSheet.Shapes(Application.Caller).Visible = False Application.ScreenUpdating = False your code here ActiveSheet.Shapes(Application.Caller).Visible = True Application.ScreenUpdating = True

The shape will still be visible but you won't be able to click it until .Visible is set true again.

ok what am i doing wrong?

Rich (BB code):

Sub BTop()
ActiveSheet.Shapes(Application.Caller).Visible = False
Application.ScreenUpdating = False

Windows("Race.xlsm").Activate
    ActiveCell.FormulaR1C1 = "1"
    ActiveCell.Offset(1, -3).Range("A1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 3).Range("A1").Select
    ActiveCell.FormulaR1C1 = "2"
    ActiveCell.Offset(0, -1).Range("A1").Select
'win list
    Windows("Registration.xlsm").Activate
    Range("C36:D39").Select
    Selection.Copy
    Range("C37").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("A28:B28").Select
    Selection.Copy
    Range("C37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'find 9
Windows("Race.xlsm").Activate
 Cells.Find(What:="9", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -2).Range("A1:C1").Select
    Selection.Copy
    Windows("Registration.xlsm").Activate
    Range("A29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Race.xlsm").Activate
    ActiveCell.Select
    Selection.End(xlUp).Select
    ActiveCell.Range("A1:C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Registration.xlsm").Activate
    Range("A28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Race.xlsm").Activate
    ActiveCell.Offset(1, 3).Range("A1").Select
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select
    Application.CutCopyMode = False
Application.ScreenUpdating = True
'time
  Application.Wait (Now + TimeValue("0:00:05"))
 Application.ScreenUpdating = False
  ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlDown).Select
    Application.ScreenUpdating = True
    Cells.Find(What:="9", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.End(xlUp).Select
Windows("Registration.xlsm").Activate
Range("A1").Select
Windows("Race.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
  Windows("Registration.xlsm").Activate
  
Application.ScreenUpdating = False
ActiveSheet.Shapes(Application.Caller).Visible = True
  Application.ScreenUpdating = True

End Sub

I don't want it to work

bluefeather8989

Active Member

bluefeather8989

Active Member

Excel Facts

Similar threads

Forum statistics

Share this page

I don't want it to work

bluefeather8989

Active Member

bluefeather8989

Active Member

Excel Facts

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock