Excel Command Buttons for data recording

[BioPA]

Hello again!

I would like to ask you if there is any way to create a template of command buttons (activeX) that they will record their values (the name of the command buttons) to the cells in a sequential way. When i want to change raw, i will simply press the enter button and the next row of cells will be ready for registering the values of the command buttons.

A practical example:

We have 14 command buttons with names ''action 1'' to ''action 14''. I start clicking the buttons (4) in order to register the actions. I press enter and i start a new sequence of actions (6) and so on

[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]...
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Action2
[/TD]
[TD]Action10
[/TD]
[TD]Action3
[/TD]
[TD]Action4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Action5
[/TD]
[TD]Action9
[/TD]
[TD]Action14
[/TD]
[TD]Action10
[/TD]
[TD]Action9
[/TD]
[TD]Action2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]Action...
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]..
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I hope that i described my question in an understandable way

 

[RickXL]

Hi,

I have nearly done what you asked for. The difference is that I have used another button instead of the Enter key. The Enter key is used for lots of things in Excel and I think it might create problems if you make it do something else instead.

You could make the last button be a completely different size to stop it becoming confused with one of the other ones. I made this special button "Button 0". I have used the same code for each button. Every one just calls another macro and passes the button number to it.

The central macro saves the current row and column offsets in Static variables. That means that they are remembered between calls to the macro. An ordinary button writes a string, e.g. "Action 1", to the current cell offset position and then increments the column offset. The special button increments the row offset and resets the column offset.

The button macros are associated with the sheet that the buttons are on while the central macro (Action) goes into a new macro module:

Macro Module:

Sub Action(Number As Long)

    Static iRowOffset As Long
    Static iColOffset As Long
    
    If Number > 0 And Number <= 14 Then
        ActiveSheet.Range("A11").Offset(iRowOffset, iColOffset).Value = "Action " & Number
        iColOffset = iColOffset + 1
    End If
    
    If Number = 0 Then
        iRowOffset = iRowOffset + 1
        iColOffset = 0
    End If

End Sub

Sheet macros:
[/code]
Private Sub CommandButton0_Click()
Call Action(0)
End Sub
Private Sub CommandButton1_Click()
Call Action(1)
End Sub
Private Sub CommandButton2_Click()
Call Action(2)
End Sub
Private Sub CommandButton3_Click()
Call Action(3)
End Sub
Private Sub CommandButton4_Click()
Call Action(4)
End Sub
Private Sub CommandButton5_Click()
Call Action(5)
End Sub
Private Sub CommandButton6_Click()
Call Action(6)
End Sub
Private Sub CommandButton7_Click()
Call Action(7)
End Sub
Private Sub CommandButton8_Click()
Call Action(8)
End Sub
Private Sub CommandButton9_Click()
Call Action(9)
End Sub
Private Sub CommandButton10_Click()
Call Action(10)
End Sub
Private Sub CommandButton11_Click()
Call Action(11)
End Sub
Private Sub CommandButton12_Click()
Call Action(12)
End Sub
Private Sub CommandButton13_Click()
Call Action(13)
End Sub
Private Sub CommandButton14_Click()
Call Action(14)
End Sub
[/code]
You will need to create a button for each action and an extra one for the "Enter" button.

 

[RickXL]

Hi,

I have written this to have the controls on one sheet and the data on the other. It would be possible to have both on one sheet with a few minor changes if you prefer.

You need to set up some data like this first:

Excel 2013
	A	B	C
1	Start	End	Name
2	e2	l5	Enter
3	e8	f10	Keith
4	e12	f14	Smith
5	e16	f18	Richard
6	h10	i12	Mike
7	h14	i16	John
8	k8	l10	Pete
9	k12	l14	Arthur
10	k16	l18	George
Sheet1

The characters in columns A and B represent cell names. For example, in row 2 there are e2 and l5. That draws a large button that covers the cells E2:L5.
So that is the mechanism for designing the button layout. You could be creative and change your cell sizes before you start.

The names in column C appear as button Captions.
To change a Caption, select the cell with the name in and overtype it then press the keyboard Enter key as usual.

Note: There is a button also captioned Enter. You will always need one of those and its name must be "Enter" (could be changed). That is the button that will cause the output to change lines.

When you have entered you choice of locations and names then run the macro called AddButtons. I assigned it to a Quick Access Toolbar button in my workbook to make it easy to run. The buttons will be redrawn and you will be asked if you want to delete the data from the second sheet. If you say No that will allow you to reorganise the buttons without losing the data. Otherwise select Yes and the data will start from cell A1.

You will need to have two sheets called Sheet1 and Sheet2 before the macro will work.

You need some macros in a macro Module and you will need a macro behind Sheet1.

Here is the code for a new Module

Option Explicit

Private ws1 As Worksheet
Private ws2 As Worksheet
Private iCol As Long
Private iRow As Long

Sub setWorksheets()
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
End Sub

Sub AddButtons()    ' Main Macro

    Dim i As Long
    Dim rLoc As Range
    Dim sh As Shape
    Dim btnObject As Object
    Dim btnName As String
    Dim btnCaption As String
    Dim btnAction As String
    
    If ws1 Is Nothing Then Call setWorksheets
    
    With ws1
        For Each sh In .Shapes
            If sh.Name Like "act###" Then sh.Delete
        Next
    
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rLoc = .Range(.Cells(i, "A") & ":" & .Cells(i, "B"))

            'create button
            btnName = "act" & Format(i, "000")
            btnCaption = .Cells(i, "C").Value
            btnAction = "Action '" & btnCaption & "'"
            Set btnObject = .Buttons.Add(rLoc.Left, rLoc.Top, rLoc.Width, rLoc.Height)
    
            With btnObject
                .Name = btnName
                .Caption = btnCaption
                .Font.Size = 14
                .Font.Name = "Calibri"
                .OnAction = "Action"
            End With
        Next
    End With
    
    If MsgBox("Do you want to clear the Data Sheet?", vbYesNo + vbQuestion, "Warning: Delete Data") = vbYes Then
        ws2.Cells.Clear
        iCol = 0
        iRow = 0
    End If
    
End Sub


Sub Action()

    Dim Name As String
    
    If ws1 Is Nothing Then Call setWorksheets
    
    Name = ws1.Shapes(Application.Caller).DrawingObject.Caption
    
    With ws2
        If iRow = 0 Then
            iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(1, "A") <> "" Then iRow = iRow + 1
            iCol = 1
        End If
    
        If Name = "Enter" Then
            iRow = iRow + 1
            iCol = 1
        Else
            .Range("A1").Cells(iRow, iCol).Value = Name
            iCol = iCol + 1
        End If
    End With
    
End Sub

and here is the code for Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Or Target.Row = 1 Then Exit Sub
    If Not Intersect(Target, Columns(3)) Is Nothing Then
        Shapes("act" & Format(Target.Row, "000")).DrawingObject.Caption = Target.Value
    End If
End Sub

The button names allow for up to 999 buttons. I have not tested it with that many!

If you need to have another copy of the workbook then just make a copy.

Let me know if you get any problems.

Regards,

 

[BioPA]

There are no words to thank you. Only some papers with the Queen depicted on them

 

[RickXL]

Hi again,

The Boss reviewed your program yesterday and liked it very much. However, he was not very pleased with the way the control screens were created. It is very tedious to enter all those cell values in columns A and B, he said. Could we do anything about it, he asked.

As it turns out, we could. We thought it would be much easier if the user could just select a bunch of cells, hit a button and the new button would appear together with the entry in the next blank row in columns A and B. Also, the functions were separated somewhat to provide more flexibility during the creation phase. Various issues with things being done in an unexpected order were noted and these no longer result in crashes.

All the macros have been renamed as well. They all now begin with "btn" as do the internal button names. The list of user macros is:

btnSingle() ' User Macro: Adds a single button based on the current selection
btnAll() ' User Macro: Refreshes the buttons from the table in columns A:C and clears data
btnClearData() ' User Macro: Will clear the data from the data sheet, Sheet2
btnDelete() ' User Macro: Will remove all the buttons from the screen

Assigning a QAT or Ribbon button to each one greatly improves the usability.
btnSingle is the new button entry mechanism. Select some cells in Sheet1 then run btnSingle and a new button will appear. Its co-ordinates will be placed in the next empty row in columns A and B and if there was a name in C it will be added.

btnAll is the old AddButtons macro. It will perform a complete refresh of the controls (and optionally the data) based on the contents of columns A to C.

btnClearData will allow you to erase the data from the data sheet. Maybe not so useful as that is covered elsewhere.

btnDelete is a way of removing the existing buttons so that a new set can be created. Another way to do this is to empty columns A and B and run btnAll. That will then redraw the buttons but there will be none.

Tables of settings can be pasted into columns A to C and btnAll will create the specified layout. So preferred layouts can be stored separately, if desired. Another approach would be to have one workbook per team.

Code to go into a macro module is:

Option Explicit

Private ws1 As Worksheet
Private ws2 As Worksheet
Private iCol As Long
Private iRow As Long

Sub btnSingle()             ' User Macro: Adds a single button based on the current selection
    Dim btnRow As Long
    If ws1 Is Nothing Then Call btnSetWorksheets
    btnRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1
    ws1.Cells(btnRow, "A").Resize(, 2).Value = Split(Selection.Address(False, False), ":")
    Call btnAdd(btnRow)
End Sub

Sub btnAll()                ' User Macro: Refreshes the buttons from the table in columns A:C and clears data
    Dim btnRow As Long
    If ws1 Is Nothing Then Call btnSetWorksheets
    Call btnClearData
    Call btnDelete
    For btnRow = 2 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        Call btnAdd(btnRow)
    Next
End Sub

Sub btnClearData()          ' User Macro: Will clear the data from the data sheet, Sheet2
    Dim btnRow As Long
    If ws1 Is Nothing Then Call btnSetWorksheets
    If WorksheetFunction.CountA(ws2.Cells) <> 0 Then
        If MsgBox("Do you want to clear the Data Sheet?", vbYesNo + vbQuestion, "Warning: Delete Data") = vbYes Then
            ws2.Cells.Clear
            iCol = 0
            iRow = 0
        End If
    End If
End Sub

Sub btnDelete()             ' User Macro: Will remove all the buttons from the screen
    Dim sh As Shape
    Application.EnableEvents = False
    On Error GoTo Err
    If ws1 Is Nothing Then Call btnSetWorksheets
    ws1.Range(Columns(4), Columns(Columns.Count)).Clear
    For Each sh In ws1.Shapes
        If sh.Name Like "btn###" Then sh.Delete
    Next
Err:
    Application.EnableEvents = True
End Sub

Sub btnAction()             ' System Macro: Is called by the buttons to log the data
    Dim Name As String
    
    If ws1 Is Nothing Then Call btnSetWorksheets
    Name = ws1.Shapes(Application.Caller).DrawingObject.Caption
    
    With ws2
        If iRow = 0 Then
            iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(1, "A") <> "" Then iRow = iRow + 1
            iCol = 1
        End If
    
        If Name = "Enter" Then
            iRow = iRow + 1
            iCol = 1
        Else
            .Range("A1").Cells(iRow, iCol).Value = Name
            iCol = iCol + 1
        End If
    End With
    
End Sub

Sub btnAdd(btnRow As Long)  ' System Macro: Adds buttons
    Dim rLoc As Range
    Dim btnName As String
    Dim btnCaption As String
    Dim btnAction As String
    Dim btnObject As Object
    
    If ws1 Is Nothing Then Call btnSetWorksheets
    With ws1
        On Error Resume Next
        Set rLoc = .Range(.Cells(btnRow, "A") & ":" & .Cells(btnRow, "B"))
        On Error GoTo 0
        If rLoc Is Nothing Then Exit Sub
        btnName = "btn" & Format(btnRow, "000")
        btnCaption = .Cells(btnRow, "C").Value
        btnAction = "Action '" & btnCaption & "'"
        Set btnObject = .Buttons.Add(rLoc.Left, rLoc.Top, rLoc.Width, rLoc.Height)
    
        With btnObject
            .Name = btnName
            .Caption = btnCaption
            .Font.Size = 14
            .Font.Name = "Calibri"
            .OnAction = "btnAction"
        End With
    End With
End Sub

Sub btnSetWorksheets()      ' System Macro: Assigns the worksheets
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
End Sub

New code for the Sheet1 module is:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Name As String
    Dim sh As Shape

    If Target.Count > 1 Or Target.Row = 1 Then Exit Sub
    If Not Intersect(Target, Columns(3)) Is Nothing Then
        Name = "btn" & Format(Target.Row, "000")
        For Each sh In Shapes
            If sh.Name = Name Then Shapes(Name).DrawingObject.Caption = Target.Value
        Next
    End If
End Sub

Enjoy!

 

[BioPA]

Kudos

 

[RickXL]

No problem.

Even I like playing with it now and I don't even know what it is for!

Regards,

 

[BioPA]

The most innovative that you did is that you create a digitization template in excel. If the buttons were 6000 for example (a typical 100x60 football field) then the user could track the actions of the game with x,y coordinates; or even add a timer so that each event will have a timestamp. Just thoughts!

Don't forget to mention that all the above should be paid

 

[RickXL]

If you want 6000 buttons I think you will need a bigger PC than mine. It went away about 10 minutes ago and is still "thinking".

I wondered about a time stamp. It would be quite easy to add one to the entry on the data sheet. In fact, this is the change required to btnAction. Change this:

.Range("A1").Cells(iRow, iCol).Value = Name

into this:

.Range("A1").Cells(iRow, iCol).Value = Name & " " & Now

That will add date and time.
This will just add time:

.Range("A1").Cells(iRow, iCol).Value = Name & " " & Time