Counting using a Button

[iaaw_esmith]

Hi,

I have placed a button on my worksheet (from the forms toolbar) Each time I click the button, I would like it to it to count: 1,2,3,4 & up to any number. Does anyone know how I might be able to do this?

Thanks

 

[Zoddy]

Hi

Have a look at Countnum.xls in attached zip file. This counts up to the number you enter, in realtime. If you want to have a max speed count just rem out the application.wait line.

Code:

Sub Countnum()

Dim Countnum As Long
Dim runum As Long
ActiveSheet.Shapes("Button 2").Select
Selection.Characters.Text = 0
Countnum = InputBox("Enter number to count to")
For runum = 1 To Countnum
Selection.Characters.Text = runum
With Selection.Characters(Start:=1, Length:=7).Font
.Size = 20
End With
Application.Wait (Now + TimeValue("0:00:01"))
Next
ActiveCell.Select
End Sub

N.B. You might have trouble identifying the Button 'number' so it might be easier to create a new button via recording a macro and ammend this code to suit

Regards

Zoddy

 

[Zoddy]

check button number

If you want to find out the button number of an existing button use this code in a new Sub

Sub Shape_Index_Name()
Dim myVar As Shapes
Dim shp As Shape
Set myVar = Sheets(1).Shapes
For Each shp In myVar
MsgBox "Index = " & shp.ZOrderPosition & vbCrLf & "Name = " _
& shp.Name
Next
End Sub

 

[iaaw_esmith]

Works great!

That works great thanks...I have one more question for you. Say if I wanted to manually count, so each time I press the button, it will count. For example, press the button once: Print 1....Press it again it will print 2. And so forth. Thanks for all your help!

Take care!

 

[Zoddy]

No Prob - sorry for delay been busy.


Try this code

Sub Manualcount()
Dim runum As Long
ActiveSheet.Shapes("Button 2").Select
runum = Selection.Characters.Text
Selection.Characters.Text = runum + 1
With Selection.Characters(Start:=1, Length:=4).Font
.Size = 20
End With
ActiveCell.Select
End Sub

This will count up with every click on the button

To reset the button to 0 use another button with the code

Sub Reset()
ActiveSheet.Shapes("Button 2").Select
Selection.Characters.Text = 0
ActiveCell.Select
End Sub