Cell Macros: how to run macro from cells...

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
I have a file where I have six buttons at the top that execute Font, RowAutofit and Zoom macros.

These buttons are on 12 sheets so that makes 108 buttons.

There are about 50 sheets in the file but only 12 get the buttons.

I was thinking it might be easier to maintain if I ran the macros from cells on these sheets.

Any thoughts?
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

like running "Macro1" by doubleclicking in a cell ?
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Macro1
End Sub

kind regards,
Erik

EDIT:
a better example might be
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Select Case Target.Address(0, 0)
    Case "A1": macro1
    Case "C1": macro2
    Case "E1": macro3
    Case "G1": macro4
    Case Else
    Exit Sub
    End Select
Cancel = True
End Sub
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
erik.van.geit--that would probably work, I'm taking since it is Private the code would have to be on each sheet?
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
erik.van.geit--oh yea that might be good, I'll start playing with some macros and get back with you--thanks a bunch...
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

yes, but that would involve too much code ...
my examples were meant to give it a try

you could put it in the workbookmodule this way
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Index > 12 Then Exit Sub
    Select Case Target.Address(0, 0)
    Case "A1": macro1
    Case "C1": macro2
    Case "E1": macro3
    Case "G1": macro4
    Case Else
    Exit Sub
    End Select
Cancel = True
End Sub
change the If ... Exit to your suits

kind regards,
Erik
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
or
Code:
Dim SheetsArray As Variant
SheetsArray = Array("WhatSheet", "SheetX", "ThisOne", "Another")
If IsError(Application.Match(Sh.Name, SheetsArray, 0)) Then Exit Sub
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778

ADVERTISEMENT

This works pretty good.

But I'm wondering if I could run the "SetFontAerial7_RowAutoFit" anytime the sheets are selected? This is a large file where I use a Main Menu and navigate to each sheet via hyperlinked cell.

The 12 sheets in question are schedule sheets with small text boxes that show what folks are doing throughout the day. For some reason the rows crop up in height so I continually reset the font and autofit the rows to get everything in order...

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Select Case Target.Address(0, 0)
    Case "L1:W1": SetFontAeral7_RowAutoFit  'merger cell range L1:W1
    Case "Z1:AA1": Zoom75    'merger cell range L1:AA1
    Case "AB1:AC1": Zoom100  'merger cell range AB1:AC1
    Case "AD1:AE1": Zoom125  'merger cell range AD1:AE1
    Case "AF1:AG1": Zoom150  'merger cell range AF1:AG1
    Case Else
    Exit Sub
    End Select
Cancel = True
End Sub

Sub SetFontAeral7_RowAutoFit()
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Range(Selection, Selection.End(xlDown)).Select
    Rows("3:248").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Name = "Arial"
        .Size = 7
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With
    Selection.Rows.AutoFit
    Range("I1").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    Application.ScreenUpdating = True
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Code:
But I'm wondering if I could run the "SetFontAerial7_RowAutoFit" anytime the sheets are selected?
this way should work
Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
SetFontAeral7_RowAutoFit
End Sub
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
Got it with

Code:
Private Sub Worksheet_Activate()
SetFontAeral7_RowAutoFit
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Got it with

Code:
Private Sub Worksheet_Activate()
SetFontAeral7_RowAutoFit
End Sub
yes, but this way you will need to repeat the code in each sheetmodule
with the workbookcode you can specify a sheetlist (see code with "SheetsArray")
Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
Dim SheetsArray As Variant 
SheetsArray = Array("WhatSheet", "SheetX", "ThisOne", "Another") 
If IsError(Application.Match(Sh.Name, SheetsArray, 0)) Then Exit Sub
SetFontAeral7_RowAutoFit 
End Sub
(not tested but will be close)
 

Forum statistics

Threads
1,136,592
Messages
5,676,690
Members
419,644
Latest member
KeelsM

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top