Filter buttons excel vba

Question

I want to filter the buttons in my sheet. need help, filter is working but the link slips I have an excel file with two worksheets. Worksheet 1 is Tabelle1 Worksheet 2 is Link in worksheet 1 the names are written in column A and in column B the Windows path for the folder.

I have written a code where buttons are automatically generated in Tabelle1. Here is the code in Module1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A:B")) Is Nothing Then
        ' If changes are made in column A or B of the "Link" worksheet
        ' then regenerate the buttons
        GenerateButtons
    ElseIf Target.Rows.Count < 2 And Not Intersect(Target, Me.Columns("A:B")) Is Nothing Then
        ' If a line has been deleted, remove the corresponding button
        RemoveButton Target.Row
    End If
End Sub

Sub GenerateButtons()
    Dim wsLink As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim btn As Button
    Dim btnText As String
    Dim topOffset As Long
    Dim folderPath As String
    
    
    Set wsLink = ThisWorkbook.Sheets("Link")
    Set wsButtons = ThisWorkbook.Sheets("Tabelle1")
    
    
    lastRow = wsLink.Cells(wsLink.Rows.Count, "A").End(xlUp).Row
    
    ' Delete buttons, if available
    For Each btn In wsButtons.Buttons
        btn.Delete
    Next btn
    
    ' Initialize the upper offset
    topOffset = 10
    
    ' Regenerate buttons
    For i = 1 To lastRow
        ' Check that the cell in column A and the corresponding cell in column B are not empty
        If wsLink.Cells(i, 1).Value <> "" And wsLink.Cells(i, 2).Value <> "" Then
            ' Button create
            Set btn = wsButtons.Buttons.Add(10, topOffset, 100, 20)
            ' Name button
            btn.Name = "Button_" & i
            ' Text button
            btn.Text = wsLink.Cells(i, 1).Value
            
            ' Makro to button
            btn.OnAction = "OpenFolder"
            ' Save additional information (here the path directly from the "Link" worksheet)
            btn.TopLeftCell.Offset(0, 500).Value = wsLink.Cells(i, 2).Value
            ' Increase the upper offset for the next button
            topOffset = topOffset + 30
        End If
    Next i
End Sub

Sub RemoveButton(ByVal rowNum As Long)
    Dim btn As Button
    
    ' Scroll through all buttons and search for the button to be deleted
    For Each btn In wsButtons.Buttons
        If btn.TopLeftCell.Row = rowNum Then
            btn.Delete
            Exit For
        End If
    Next btn
End Sub

Sub OpenFolder()
    Dim btn As Button
    Dim folderPath As String
    
    ' Determine the button that triggered the macro
    Set btn = ActiveSheet.Buttons(Application.Caller)
    ' Get path from the additional information of the button
    folderPath = btn.TopLeftCell.Offset(0, 500).Text
    'folderPath = wsLink.Cells(i, 2).Value // bu olmuyor

    'open folder
    Call Shell("explorer.exe """ & folderPath & """", vbNormalFocus)
End Sub

Now I have also written a code for TextBoxSearch so a filter TextBox for the buttons, so that I can filter the buttons if I want. This TextBox is in Tabelle1.

Normal filter code without repositioning the button places after the filter: (this fits as far as the links go)

Private Sub TextBoxSuche_Change()
    Dim searchTerm As String
    Dim btn As Button
    
    ' Extract words from the TextBox
    searchTerm = LCase(TextBoxSuche.Value)
    
    ' Go through all buttons and search for matches
    For Each btn In ActiveSheet.Buttons
        If InStr(1, LCase(btn.Text), searchTerm) > 0 Then
            btn.Visible = True
        Else
            btn.Visible = False
        End If
    Next btn
End Sub

Now I have changed the code a bit so that the buttons are listed one after the other after the filter but now the links don't work. Code for this:

Private Sub TextBoxSuche_Change()
    Dim searchTerm As String
    Dim btn As Button
    Dim topPosition As Double
    Dim leftPosition As Double
    
    ' Set the start position for the buttons
    topPosition = 10 ' Ändere dies auf den gewünschten Startwert
    leftPosition = 10 ' Ändere dies auf den gewünschten Startwert
    
    ' Extract words from the TextBox
    searchTerm = LCase(TextBoxSuche.Value)
    
    ' Go through all buttons and search for matches
    For Each btn In ActiveSheet.Buttons
        If InStr(1, LCase(btn.Text), searchTerm) > 0 Then
            ' Make button visible and position it
            btn.Visible = True
            btn.Top = topPosition
            btn.Left = leftPosition
            
            ' Increase the top position for the next button
            topPosition = topPosition + btn.Height + 5 ' Ändere den Abstand nach Bedarf
        Else
            ' Hide button
            btn.Visible = False
        End If
    Next btn
End Sub

How can I solve this I need help. Also if the code needs to be changed. gladly..

Answer 1

It might simplify your workflow to know that you can include arguments when calling a macro via On Action

For example:

Sub OpenFolder(folderPath As String)    
    Debug.Print theFolder
    Shell "explorer.exe """ & folderPath & """", vbNormalFocus 
End Sub

'demo assigning `OnAction` with a fixed argument
Sub linkup()
    'note the enclosing single-quotes
    ActiveSheet.Shapes(1).OnAction = "'OpenFolder ""C:\Temp""'" 
End Sub

That way you don't need to worry about keeping your button locations synced with paths stored on the same worksheet.

To update your existing code:

' Makro to button
btn.OnAction = "'OpenFolder """ & wsLink.Cells(i, 2).Value & """'"

...and remove any code related to btn.TopLeftCell.Offset(0, 500)