Help Needed! Macro to Create and Connect Buttons with Multiple Sheets

[The_Steward]

I need to create a set of buttons (using a for loop) that all have the ability to clear the contents of a select amount of cells on different worksheets (all worksheets are identical).

All the worksheet names are in a list in a separate sheet (Column 8/H in 'Code and Data Centre') , and I have already created a for loop to create all the buttons, and a macro that will clear the cells, but I just don't know how to link each button with the separate sheets.

All the buttons will be on a directory page (SIL Selection)

Any suggestions are very welcome. Thankyou in advance!

This is the two macros I have so far:

Sub create_clearSILButton()

Dim macrobook As Workbook
Set macrobook = ThisWorkbook

Dim y As Long
Dim x As Long

Dim iconloop As Long


Dim SilSelection As Worksheet
Set SilSelection = macrobook.Sheets("SIL House Selection")


SilSelection.Activate
x = -400
y = -60





For iconloop = 1 To 3
Dim icons As Picture
Set icons = SilSelection.Pictures.Insert("https://cdn.hubblecontent.osi.office.net/icons/publish/icons_eraser_m/eraser_m.svg")

With icons.Select


    Selection.ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.IncrementLeft x
    Selection.ShapeRange.IncrementTop y
End With



    y = y + 60
    x = -400

Next iconloop

End Sub

Sub ClearSILContent()
'
' ClearSILContent Macro
' Clear all content for a SIL page so it is restored to default
'

'
    Range("H6:I8,H15:I17,M6:O25").Select
    Selection.ClearContents
End Sub

 

[sijpie]

For the clear macro the easiest way is to pass the sheet name as a parameter. However you can't do that with a macro called from a button. So in the macro we are going to get the name of the button that was pressed to run the macro. If you give the buttons a name related to the name of the sheet to be cleared, that will then do the trick.

Sub ClearSILContent()
'
' ClearSILContent Macro
' Clear all content for a SIL page so it is restored to default

    Dim sSheet as String

    sSheet= Application.Caller     ' The butons will be named 'ClearSheetx'
    sSheet= Replace(sSheet, "Clear", "")   ' Remove 'Clear'  from the name

'
    Sheets(sSheet).Range("H6:I8,H15:I17,M6:O25").ClearContents

' Don't select a range first. Just follow the range with the operation



End Sub

The IconLoop then becomes:

Sub create_clearSILButton()

Dim MacroBook As Workbook
Dim SilSelection As Worksheet
Dim IconLoop As Long
Dim Icons As Picture
Dim y As Long
Dim x As Long
Const sSheetNames as string = "Sheet1;Sheet2;Sheet3"   '<<<< Here you should list the sheetnames, in order, associated with icon 1,2 and 3
dim vSplit as variant
' Group all your Dim's at the top for easier maintenance
' Also always use at least on Capital letter in the name, when you then type with lower case, VBA editor should change it to uppercase. This way you can spot typo's better.

vSplit = split(sSheetNames,";")    ' put the sheetnames into an array

Set macrobook = ThisWorkbook

Set SilSelection = macrobook.Sheets("SIL House Selection")
SilSelection.Activate
x = -400
y = -60

For iconloop = 1 To 3
    Set icons = SilSelection.Pictures.Insert("https://cdn.hubblecontent.osi.office.net/icons/publish/icons_eraser_m/eraser_m.svg")

    With icons


        .ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
        .ShapeRange.IncrementLeft x
        .ShapeRange.IncrementTop y
        .OnAction = "ClearSILContent()"
        .Name = "Clear" & vSplit(iconloop-1)    ' the vSplit array runs from 0 to 2 (for three sheet names)
    End With

    y = y + 60
    x = -400

Next iconloop

End Sub

 

[The_Steward]

Hey! Thanks so much for your assistance.

I feel like it's quite close to working.

Created the buttons fine and linked them with the Macro. The first time I ran it I got ambiguous name error, so I went and changed the other macro I had forgotten to change the name of.

I then deleted the buttons, created them again, and then tried clicking on them to run the macro, except this time it couldn't find the ClearSILContentMacro () and came up with the error that it may not be available or all macros have disabled. Other Macros still run fine so it just doesn't seem to be finding the macro.

Btw, rather than listing sheet names can I extract sheet names from a column where I already have sheet names listed. I want to eventually make the loop to be 20 sheets but just testing with 3 right now. Would below work?

lRow = Sheets("Code and Data Centre").Cells(Rows.Count, 8).End(xlUp).Row
 
  VSplit = Sheets("Code and Data Centre").Range("H4:H" & lRow).Value

 

[sijpie]

My error. Change the .OnAction line to the name of the sub without the () brackets

    With icons


        .ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
        .ShapeRange.IncrementLeft x
        .ShapeRange.IncrementTop y
        .OnAction = "ClearSILContent"
        .Name = "Clear" & vSplit(iconloop-1)    ' the vSplit array runs from 0 to 2 (for three sheet names)
    End With

The full macro then becomes (including getting the sheet names off the workbook)

Sub create_clearSILButton()

    Dim MacroBook As Workbook
    Dim SilSelection As Worksheet
    Dim Icons As Picture
    Dim IconLoop As Long, y As Long, x As Long, lRow As Long
    Dim vShtNames As Variant
    ' Group all your Dim's at the top for easier maintenance
    ' Also always use at least on Capital letter in the name, when you then type with lower case, VBA editor should change it to uppercase. This way you can spot typo's better.
    
    Set MacroBook = ThisWorkbook
    With MacroBook.Sheets("Code and Data Centre")
       lRow = .Cells(Rows.Count, 8).End(xlUp).Row
       vShtNames = .Range("H4:H" & lRow).Value
    End With
    
    
    Set SilSelection = MacroBook.Sheets("SIL House Selection")
    SilSelection.Activate
    x = -400
    y = -60
    
    For IconLoop = 1 To 3
        Set Icons = SilSelection.Pictures.Insert("https://cdn.hubblecontent.osi.office.net/icons/publish/icons_eraser_m/eraser_m.svg")
    
        With Icons
    
    
            .ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
            .ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
            .ShapeRange.IncrementLeft x
            .ShapeRange.IncrementTop y
            .OnAction = "ClearSILContent"
            .Name = "Clear" & vShtNames(IconLoop)   ' give button sheet name with "Clear" appended
        End With
    
        y = y + 60
        x = -400
    
    Next IconLoop

End Sub

Sub ClearSILContent()
    '
    ' ClearSILContent Macro
    ' Clear all content for a SIL page so it is restored to default

    Dim sSheet As String

    sSheet = Application.Caller    ' The butons will be named 'ClearSheetName'
    sSheet = Replace(sSheet, "Clear", "")  ' Remove 'Clear'  from the name

    Sheets(sSheet).Range("H6:I8,H15:I17,M6:O25").ClearContents


End Sub

 

[The_Steward]

My error. Change the .OnAction line to the name of the sub without the () brackets

    With icons


        .ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
        .ShapeRange.IncrementLeft x
        .ShapeRange.IncrementTop y
        .OnAction = "ClearSILContent"
        .Name = "Clear" & vSplit(iconloop-1)    ' the vSplit array runs from 0 to 2 (for three sheet names)
    End With

The full macro then becomes (including getting the sheet names off the workbook)

Sub create_clearSILButton()

    Dim MacroBook As Workbook
    Dim SilSelection As Worksheet
    Dim Icons As Picture
    Dim IconLoop As Long, y As Long, x As Long, lRow As Long
    Dim vShtNames As Variant
    ' Group all your Dim's at the top for easier maintenance
    ' Also always use at least on Capital letter in the name, when you then type with lower case, VBA editor should change it to uppercase. This way you can spot typo's better.
   
    Set MacroBook = ThisWorkbook
    With MacroBook.Sheets("Code and Data Centre")
       lRow = .Cells(Rows.Count, 8).End(xlUp).Row
       vShtNames = .Range("H4:H" & lRow).Value
    End With
   
   
    Set SilSelection = MacroBook.Sheets("SIL House Selection")
    SilSelection.Activate
    x = -400
    y = -60
   
    For IconLoop = 1 To 3
        Set Icons = SilSelection.Pictures.Insert("https://cdn.hubblecontent.osi.office.net/icons/publish/icons_eraser_m/eraser_m.svg")
   
        With Icons
   
   
            .ShapeRange.ScaleWidth 0.7505082319, msoFalse, msoScaleFromTopLeft
            .ShapeRange.ScaleHeight 0.7505084746, msoFalse, msoScaleFromTopLeft
            .ShapeRange.IncrementLeft x
            .ShapeRange.IncrementTop y
            .OnAction = "ClearSILContent"
            .Name = "Clear" & vShtNames(IconLoop)   ' give button sheet name with "Clear" appended
        End With
   
        y = y + 60
        x = -400
   
    Next IconLoop

End Sub

Sub ClearSILContent()
    '
    ' ClearSILContent Macro
    ' Clear all content for a SIL page so it is restored to default

    Dim sSheet As String

    sSheet = Application.Caller    ' The butons will be named 'ClearSheetName'
    sSheet = Replace(sSheet, "Clear", "")  ' Remove 'Clear'  from the name

    Sheets(sSheet).Range("H6:I8,H15:I17,M6:O25").ClearContents


End Sub

I feel silly for missing that too. :') Worked perfect after fixing that.

Second code was having trouble with finding the correct sheet names in the column. Kept saying subscript out of range.

Couldn't find the value for vShtNames.

Which was weird because it was counting everything right
lRow = 23
vShtNames type = Variant (1 to 20, 1 to 1) 'Counting from row 4 to 23 correctly
vShtNames value = blank <problem here

I'm totally happy to run with edited version of first macro but would be nice to run a cleaner macro if possible.

 

[sijpie]

Your list of sheet names, column H, starting from row. 4 Does it have a header? Is the column free, or is there anything in the columns next to it?

If it is free from neighbours then you can also do this:

With MacroBook.Sheets("Code and Data Centre")
       
       vShtNames = .Range("H4").currentregion.Value
    End With

I'd it had a header, then take account of that in the loop, start from row 2 of the array.

You can set a bookmark on the code line above (double click the mouse in the border left to the line. Run the code. It will stop here. The press F8 so the line gets executed. In the area below the code you should have a variable window, else use view menu to show it. Now you can check the contents of the vshtnames array.

 

[sijpie]

Aaahhhh!!! My mistake: the array has 2 dimensions, so it needs to be addressed as vShtNames(IconLoop, 1)

So in your code

.Name = "Clear" & vShtNames(IconLoop, 1) ' give button sheet name with "Clear"

 

[The_Steward]

Your list of sheet names, column H, starting from row. 4 Does it have a header? Is the column free, or is there anything in the columns next to it?

If it is free from neighbours then you can also do this:

With MacroBook.Sheets("Code and Data Centre")
      
       vShtNames = .Range("H4").currentregion.Value
    End With

I'd it had a header, then take account of that in the loop, start from row 2 of the array.

You can set a bookmark on the code line above (double click the mouse in the border left to the line. Run the code. It will stop here. The press F8 so the line gets executed. In the area below the code you should have a variable window, else use view menu to show it. Now you can check the contents of the vshtnames array.

Attached below is image of how it looks. So no official header but there is text in H2 and H3. I did move the text from H2 and try what you suggested but no luck.

 

[The_Steward]

Aaahhhh!!! My mistake: the array has 2 dimensions, so it needs to be addressed as vShtNames(IconLoop, 1)

So in your code

.Name = "Clear" & vShtNames(IconLoop, 1) ' give button sheet name with "Clear"

AMAZING! WORKED! THANKYOU SO MUCH!