Add buttons automatically based on table values. Each button press adds button label to cell L2 on dashboard

[allen675]

Good day to you all,

The tile states it all really. This is my code so far:

Sub AddButtonsInGrid()
    Dim SourceSheet As Worksheet
    Dim DashboardSheet As Worksheet
    Dim Table As ListObject
    Dim ButtonLeft As Double
    Dim ButtonTop As Double
    Dim Cell As Range
    Dim NewButton As Object
    Dim ButtonSpacing As Double
    
    ' Set the source and dashboard sheets
    Set SourceSheet = ThisWorkbook.Sheets("LookupLists")
    Set DashboardSheet = ThisWorkbook.Sheets("Dashboard")
    
    ' Clear existing buttons on the dashboard (if any)
    DashboardSheet.OLEObjects.Delete
    
    ' Initialize button positioning
    ButtonLeft = 10
    ButtonTop = 10
    ButtonSpacing = 25
    
    ' Initialize the concatenated value
    Dim ConcatenatedValue As String
    ConcatenatedValue = ""
    
    ' Loop through the tables in the source sheet
    For Each Table In SourceSheet.ListObjects
        ' Loop through the cells in the first column of the table's data body range (excluding headers)
        For Each Cell In Table.ListColumns(1).DataBodyRange
            ' Create a button for each cell's value
            Set NewButton = DashboardSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
              Link:=False, DisplayAsIcon:=False, Left:=ButtonLeft, Top:=ButtonTop, Width:=100, Height:=20)
            
            ' Set the button's label to the cell's value
            NewButton.Object.Caption = Cell.Value
            
            ' Assign a macro to the button
            NewButton.Object.OnAction = "AddValueToConcatenatedValue"
            
            ' Adjust the left position for the next button in the same column
            ButtonTop = ButtonTop + ButtonSpacing
        Next Cell
        
        ' Move to the next column
        ButtonTop = 10
        ButtonLeft = ButtonLeft + 120
    Next Table
    
    ' Add a cell to display the concatenated value (cell L2)
    DashboardSheet.Range("L2").Value = ConcatenatedValue
End Sub

Sub AddValueToConcatenatedValue()
    Dim ButtonLabel As String
    
    ' Get the label of the clicked button
    ButtonLabel = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Caption
    
    ' Update the concatenated value in cell L2
    ThisWorkbook.Sheets("Dashboard").Range("L2").Value = ThisWorkbook.Sheets("Dashboard").Range("L2").Value & ", " & ButtonLabel
End Sub

I have this code in a module. I am getting stuck at

NewButton.Object.OnAction = "AddValueToConcatenatedValue"

and get a run-time error 438 Object doesnt support this property or method. Think its something really simple that I am missing but cant work it out

Your help would be greatly appreciated. Thanking you in advance

 

[Domenic]

ActiveX controls, such as your CommandButton, do not contain the OnAction property. Instead, they use sheet driven event handlers. So this means that your code would have to insert the appropriate event handler for each new CommandButton. And it would need to delete the event handlers when it deletes the buttons. All of this would require that you allow access to the VBA project object model. So while your code can be amended accordingly, it would make things much more complex.

As an alternative, though, I would suggest that you use Buttons from Form controls instead. As such, your code could be easily amended as follows...

Sub AddButtonsInGrid()
    Dim SourceSheet As Worksheet
    Dim DashboardSheet As Worksheet
    Dim Table As ListObject
    Dim ButtonLeft As Double
    Dim ButtonTop As Double
    Dim Cell As Range
    Dim NewButton As Object
    Dim ButtonSpacing As Double
 
    ' Set the source and dashboard sheets
    Set SourceSheet = ThisWorkbook.Sheets("LookupLists")
    Set DashboardSheet = ThisWorkbook.Sheets("Dashboard")
 
    ' Clear existing buttons on the dashboard (if any)
    DashboardSheet.Buttons.Delete
 
    ' Initialize button positioning
    ButtonLeft = 10
    ButtonTop = 10
    ButtonSpacing = 25
 
    ' Initialize the concatenated value
    Dim ConcatenatedValue As String
    ConcatenatedValue = ""
 
    ' Loop through the tables in the source sheet
    For Each Table In SourceSheet.ListObjects
        ' Loop through the cells in the first column of the table's data body range (excluding headers)
        For Each Cell In Table.ListColumns(1).DataBodyRange
            ' Create a button for each cell's value
            Set NewButton = DashboardSheet.Buttons.Add(Left:=ButtonLeft, Top:=ButtonTop, Width:=100, Height:=20)
         
            ' Set the button's label to the cell's value
            NewButton.Caption = Cell.Value
         
            ' Assign a macro to the button
            NewButton.OnAction = "AddValueToConcatenatedValue"
         
            ' Adjust the left position for the next button in the same column
            ButtonTop = ButtonTop + ButtonSpacing
        Next Cell
     
        ' Move to the next column
        ButtonTop = 10
        ButtonLeft = ButtonLeft + 120
    Next Table
 
    ' Add a cell to display the concatenated value (cell L2)
    DashboardSheet.Range("L2").Value = ConcatenatedValue
End Sub

Does this help?

 

[allen675]

@Domenic that works a charm, thank you for your help

 

[Domenic]

You're very welcome, I'm glad I could help.

Cheers!

 

[allen675]

Just out of curiosity rather than the values going into a cell would it be possible to put them into a listbox on the worksheet?

 

[Domenic]

Sure, first add a ListBox from the Form controls group to your worksheet called "Dashboard". Then you might want to link your ListBox to a worksheet cell (right-click the ListBox >> Format Control >> Control >> Cell link) so that you can determine which item is selected, if any. Then amend your code as follows...

Sub AddButtonsInGrid()
    Dim SourceSheet As Worksheet
    Dim DashboardSheet As Worksheet
    Dim Table As ListObject
    Dim ButtonLeft As Double
    Dim ButtonTop As Double
    Dim Cell As Range
    Dim NewButton As Object
    Dim ButtonSpacing As Double
    
    ' Set the source and dashboard sheets
    Set SourceSheet = ThisWorkbook.Sheets("LookupLists")
    Set DashboardSheet = ThisWorkbook.Sheets("Dashboard")
    
    ' Clear existing buttons on the dashboard (if any)
    DashboardSheet.Buttons.Delete
    
    ' Clear the items from the ListBox
    DashboardSheet.ListBoxes("List Box 1").RemoveAllItems
    
    ' Initialize button positioning
    ButtonLeft = 10
    ButtonTop = 10
    ButtonSpacing = 25
    
    ' Initialize the concatenated value
    Dim ConcatenatedValue As String
    ConcatenatedValue = ""
    
    ' Loop through the tables in the source sheet
    For Each Table In SourceSheet.ListObjects
        ' Loop through the cells in the first column of the table's data body range (excluding headers)
        For Each Cell In Table.ListColumns(1).DataBodyRange
            ' Create a button for each cell's value
            Set NewButton = DashboardSheet.Buttons.Add(Left:=ButtonLeft, Top:=ButtonTop, Width:=100, Height:=20)
            
            ' Set the button's label to the cell's value
            NewButton.Caption = Cell.Value
            
            ' Assign a macro to the button
            NewButton.OnAction = "AddValueToListBox"
            
            ' Adjust the left position for the next button in the same column
            ButtonTop = ButtonTop + ButtonSpacing
        Next Cell
        
        ' Move to the next column
        ButtonTop = 10
        ButtonLeft = ButtonLeft + 120
    Next Table
    
    ' Add a cell to display the concatenated value (cell L2)
    DashboardSheet.Range("L2").Value = ConcatenatedValue
End Sub

Sub AddValueToListBox()
    Dim ButtonLabel As String
    
    ' Get the label of the clicked button
    ButtonLabel = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Caption
    
    ' Add the label to the listbox
    ThisWorkbook.Sheets("Dashboard").ListBoxes("List Box 1").AddItem ButtonLabel
    
End Sub

Hope this helps!

 

[allen675]

@Domenic Hi sorry for the delay! I have followed your guide above and I am hitting an error as follows:

Run-time error '1004': The item wasnt found. This happens on the his line:

DashboardSheet.ListBoxes("ListBox777").RemoveAllItems

I'm wondering if it is the listbox name?

 

[Domenic]

Yes, it's likely the listbox name. ctrl-click the listbox, and check the Name Box to the left of the formula bar. Is the name correct?

 

[allen675]

@Domenic fixed it. Spaces in the list box were required. Thank you so much for your help

 

[Domenic]

That's great . . .

Cheers!