tommyboy2340
New Member
- Joined
- Oct 6, 2021
- Messages
- 9
- Office Version
- 365
- Platform
- 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