Assigning a Macro to a Shape in another Macro

tommyboy2340

New Member
Joined
Oct 6, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hello, I am relatively new to coding in VBA. I am trying to make a code where it looks at a list of company names (That is dynamic), makes a shape (button) for every value in the list, assigns a name and a macro to each shape based on the list. I am able to get the shapes and the names on the shapes, however, the macros are not assigning to each shape. Each shape is supposed to filter a different list based on whatever the name of the company is (the name on the original list=shape name=filter name). I have attached my code, if anyone has any tips I would appreciate it!


VBA Code:
Option Explicit

Public Sub ListContractors()

Dim Contractor As String, ContrID As String, ListName As String
Dim ContrName As String
Dim ContrCol As Long, ContrRow As Long, LastContrRow As Long
Dim ListRow As Long, ListCol As Long
Dim LastResultRow As Long, ResultRow As Long
Dim shp As Shape, i As Long

    Sheet1.Select
    LastContrRow = 999
    ListRow = 2
'Create list of Contractors
  Sheet3.Select
  ListName = "Georlia"
  LastContrRow = 999
  ListRow = 2
    For ContrRow = 2 To LastContrRow
    Contractor = Sheet3.Range("C" & ContrRow).Value
    If Contractor = "zzzz" Then
        GoTo NoContractors:
    ElseIf Contractor = "" Then
        GoTo NoContractors:
    ElseIf Contractor = ListName Then
        ContrRow = ContrRow
    ElseIf Contractor <> ListName Then Range("C" & ContrRow).Select
                Set shp = Sheet1.Shapes.AddShape(msoShapeRoundedRectangle, 275, 300 - i, 300, 25)
                i = i - 30
                ListName = Sheet3.Range("C" & ListRow).Value
                ListRow = ListRow + 1
            
                With shp
                    .TextFrame.Characters.Text = ListName
                    .TextFrame.Characters.Font.Bold = True
                    .Fill.Visible = msoTrue
                    .Fill.Transparency = 0#
                    .Line.Visible = msoFalse
                    .OnAction = "Macro"
                    Sheet3.Select
                End With
     End If

NoContractors:  Application.CutCopyMode = False
'Cont:   Worksheets("Table").Range("$AB$1:$AF$999").AutoFilter Field:=5, Criteria1:=Contractor
     Next ContrRow

    
End Sub

Public Sub Macro(Optional ByVal ListName As String)

Call ListContractors

ActiveWorkbook.Worksheets("Table").Range("$AB$1:$AF$999").AutoFilter Field:=5, Criteria2:=ListName
End Sub
 

tommyboy2340

New Member
Joined
Oct 6, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
If the script is the same for all company names.
And you want to use buttons.
Why not have the script in the button ask you what is the sheet name.

Or you can use a Combobox with all the sheet name and when you click on "Alpha"
The script would know the company name

No need to have 20 buttons if all the scripts are the same except for company names

If you want something like this I can write a script to do that.
That would be perfect!
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,233
Office Version
  1. 2013
Platform
  1. Windows
That would be perfect!
I know something like my suggestion would work but I'm not really familiar with auto filter.
I have to sign off I will try and be back later.
Or maybe someone else here will b able to help you.
Still not sure what you script does and its a very large range.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,233
Office Version
  1. 2013
Platform
  1. Windows
Try this:
Since I do not have a range like you just try this in a button
The script asks for the company name
VBA Code:
Sub My_Script()
'Modified 10/8/2021  2:52:49 PM  EDT
Application.ScreenUpdating = False
Dim Listname As String


Listname = InputBox("Enter the company name")
ActiveWorkbook.Worksheets("Table").Range("$AB$1:$AF$999").AutoFilter Field:=5, Criteria1:=Listname
Application.ScreenUpdating = True
End Sub
 

tommyboy2340

New Member
Joined
Oct 6, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Try this:
Since I do not have a range like you just try this in a button
The script asks for the company name
VBA Code:
Sub My_Script()
'Modified 10/8/2021  2:52:49 PM  EDT
Application.ScreenUpdating = False
Dim Listname As String


Listname = InputBox("Enter the company name")
ActiveWorkbook.Worksheets("Table").Range("$AB$1:$AF$999").AutoFilter Field:=5, Criteria1:=Listname
Application.ScreenUpdating = True
End Sub
Thats perfect! Thank you
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,840
Messages
5,766,729
Members
425,375
Latest member
Bradleyckx

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