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

 

[allen675]

@Domenic can I pick your brains further please? Can I add a double click event to the list box that then removes the selected item? If so how would I achieve this?

Thanks in advance

 

[Domenic]

Form controls, such as your ListBox, do not have event handlers. I would suggest that you add another button to delete the selected item from the ListBox. So the user would first select an item from the ListBox, and then click on the delete button to remove it. So your code could be amended as follows...

Option Explicit

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
   
    ' Add a button to delete selected item from the ListBox (change the position of the button as desired)
    With DashboardSheet.Buttons.Add(Left:=ButtonLeft, Top:=ButtonTop, Width:=100, Height:=20)
        .Caption = "Delete"
        .OnAction = "DeleteSelectedItemFromListBox"
    End With
   
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

Sub DeleteSelectedItemFromListBox()

    With ThisWorkbook.Sheets("Dashboard").ListBoxes("List Box 1")
        Dim i As Long
        For i = 1 To .ListCount
            If .Selected(i) = True Then
                .RemoveItem i
                Exit For
            End If
        Next i
    End With
   
End Sub

Hope this helps!

 

[allen675]

@Domenic thank you. I did try something similar however the piece of code that clears all existing buttons before updating the sheet with the new buttons also deletes the delete button??

 

[Domenic]

Yes, that's correct. If that's not what you want, then the only thing you'll need to do is to add the macro DeleteSelectedItemFromListBox() to your code module, and manually add the button, change the caption as desired, and assign the macro. And so you don't need to change the macro AddButtonsInGrid() at all.