Buttons in Excel. how can you simplify

Question

I have this problem. I've only been doing VBA for about a week. I have a workbook where I created a button that copies a certain range in a row and pastes it into a table on another sheet. My problem is this: do I need to create a module for each button, or can I somehow simplify the code to create the same buttons for each row on the first sheet?

Sub SelectRangea()

    Sheets("Tournaments").Select
    Range("B4:G4").Select
    Application.CutCopyMode = False
    Selection.Copy

    With Sheets("Results")
       lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
       .Range("A" & lst).PasteSpecial xlPasteColumnWidths
       .Range("A" & lst).PasteSpecial xlPasteValues
    End With

End Sub

score 0 · Answer 1 · answered Dec 01 '21 at 05:17

You'll need to adjust the code accordingly but this will add a set of buttons for you as well as tell you the cell that the button was pressed from ...

Public Sub AddButtons()
    Dim lngRow As Long, rngCell As Range, objButton As Shape
    
    For lngRow = 1 To 10
        Set rngCell = Sheet1.Cells(lngRow, 1)
        
        Set objButton = Sheet1.Shapes.AddFormControl(xlButtonControl, rngCell.Left, rngCell.Top, rngCell.Width, rngCell.Height)
        objButton.OnAction = "ButtonPushAction"
    Next
End Sub

Public Sub ButtonPushAction()
    Dim objCaller As Shape
    
    Set objCaller = Sheet1.Shapes(Application.Caller)
    
    MsgBox "Top Cell = " & objCaller.TopLeftCell.Address & vbCrLf & _
        "Row = " & objCaller.TopLeftCell.Cells(1, 1).Row & vbCrLf & _
        "Column = " & objCaller.TopLeftCell.Cells(1, 1).Column, vbInformation, "Button Push"
End Sub

score 0 · Answer 2 · 2021-12-01T17:43:05.253

Do I need to create a module for each button?

We only need to create one module containing the macros needed by the buttons and we can use the same macro for all the buttons.

Can I somehow simplify the code to create the same buttons for each row on the first sheet?

All the buttons should be identical, except their names. They can be copies of each other.

I assume we want to copy the row clicked. So I changed SelectRangea:

' Copy the code below to a standard module
Public Sub SelectRangea(RowNumber As Integer)
    ' Copy the row clicked
    Sheets("Tournaments").Select
    Range("B" & RowNumber & ":G" & RowNumber).Select
    Application.CutCopyMode = False
    Selection.Copy

    ' Paste the row clocked
    With Sheets("Results")
       lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
       .Range("A" & lst).PasteSpecial xlPasteColumnWidths
       .Range("A" & lst).PasteSpecial xlPasteValues
    End With
End Sub

And here is the click handler for the buttons:

' Copy the code below to a standard module
Public Sub MyButton_Click()
    Dim Btn As Object
    Dim RowNumber As Integer
    'Set Btn = ActiveSheet.Buttons(Application.Caller) ' either this
    Set Btn = ActiveSheet.Shapes(Application.Caller) ' or this
    With Btn.TopLeftCell 
        RowNumber = .Row
    End With 
    SelectRangea RowNumber
End Sub

Automatically create the buttons

We could create a macro that creates the buttons, if they don't exist, using Sheet.Shapes.AddShape and sets the .OnAction of them to MyButton_Click:

' Copy the code below to a standard module.
' Create buttons on a sheet.
' Sht         : The sheet to create buttons on
' RowNumber   : Create buttons from RowNumber and down.
' ColNumber   : The column the button is created in.
' ColNumberSrc: The column used to determine the number of rows.
Public Sub AddButtons(Sht As WorkSheet,
               RowNumber As Integer,
               ColNumber As Integer, 
               ColNumberSrc As Integer)
    Dim MyLeft As Double
    Dim MyTop As Double
    Dim Rng As Range
    Dim Shp As Shape
    Dim NumRows As Integer
    
    NumRows = Sht.Range.Cells(Sht.Rows.Count, ColNumberSrc).End(xlUp).Row
    If NumRows < RowNumber Then Exit Sub
    For Idx = RowNumber To NumRows
        Set Rng = Sht.Range.Cells(Idx, ColNumber)
        MyLeft = Rng.Left
        MyTop = Rng.Top
        ' We could let the size of the button's we create be the same size as the cell.
        Set Shp = Sht.Shapes.AddShape(msoShapeRectangle, MyLeft, MyTop, 100, 22)
        Shp.Name = "Btn" & Sht.Index & "_" & Idx
        Shp.TextFrame.Characters.Text = "Clickme"
        Shp.OnAction = "MyButton_Click"
    Next Idx
End Sub

Don't use buttons

We could remove the buttons and use double-click instead. This will copy the double-clicked row:

' Copy the three lines to the corresponding function in your sheet module.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RowNumber As Integer
    RowNumber = Target.Row
    SelectRangea RowNumber
End Sub

Don't confuse the user

We should avoid the use of Copy and Select, as it can worsen the user experience. We should only use them when the user expects us to use them. Refactor the code to avoid using them:

' Copy the code below to a standard module
Public Sub SelectRangea(ByVal RowNumber As Integer)
    Dim Sht As WorkSheet
    Dim Rng As Range
    Dim Dat As Variant
    
    ' Copy the row clicked
    Set Sht = Sheets("Tournaments")
    Set Rng = Sht.Range("B" & RowNumber & ":G" & RowNumber)
    Dat = Rng
    ' Paste the row
    Set Sht = Sheets("Results")
    RowNumber = Sht.Range("A" & Sht.Rows.Count).End(xlUp).Row + 1
    Set Rng = Sht.Range("B" & RowNumber & ":G" & RowNumber)
    Rng = Dat
    ' Fix column widths
    Sht.UsedRange.Columns.AutoFit 
End Sub

NB

I don't have access to an office environment, so I can't test the code at the moment.

I think we can set an option for a shape so it stays in it's cell when cells are resized, added or deleted.

@1ncognitoff Updated the question for clarity and added method to show how to add shapes. — , Dec 01 '21 at 17:35

Buttons in Excel. how can you simplify

2 Answers2

Automatically create the buttons

Don't use buttons

Don't confuse the user

See also

NB