Buttons in Excel. how can you simplify - excel

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

Answer 1

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

Answer 2

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
See also
how to add a shape at a specific cell
how to get the row number of the button clicked.
how to get the row of the cell clicked
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.