Time based VBA script for exercises

Question

I have an excel spreadsheet with two columns, one with a list of exercises (33 of them) and a number of reps for each. What I really want is a program that picks a random exercise, displays it with it's number of reps, and has a button that says something like "Done?" When you click it, I want a timer that counts down 20 minutes, picks a new exercise and waits until you click done, and repeat.

I know this isn't hard, but I am no programmer by any means. If anyone has a tutorial or another way of doing this (flash?), I would really appreciate it.

Thanks in advance, Jay

Answer 1

What you are asking for is not too difficult but not that easy to explain if you are not used to using userforms etc.

Instead, I have come up with a more simplified solution that may suit your needs. For the purpose of this solution, I am assuming all your exercises are listed in column A and reps in column B. The following code will randomly select an exercise, highlight the chosen selection, and then in column C show a countdown from 20 mins to 0 at 1 minute intervals. As a visualisation:

        A              B            C
1       Bench press    20 reps  
2       Abs            10 reps      
3       Lateral raise  15 reps      14 mins <-display of minutes remaining
4       Bicep curl     8 reps
5       Calf raise     10 reps
6       etc

To achieve this, first add the following code into a module (Alt + F11, then Insert > Module)

Sub StartExercise()
'Get number of exercises
Dim NumberOfExercises As Integer
NumberOfExercises = Range("A1").End(xlDown).Row - 1

'Reset font to normal black and clear anything in column C
Range("A1:B" & NumberOfExercises + 1).Font.Bold = False
Range("A" & NumberOfExercises + 1 & ":" & "B" & NumberOfExercises + 1).Font.ColorIndex = 1
Range("C1:C" & NumberOfExercises + 1).Clear

'Select a random exercise
Dim RandomExercise As Integer
RandomExercise = Int(Rnd() * (NumberOfExercises - 1 + 1) + 1)

'Highlight selected exercise and reps
Range("A" & RandomExercise + 1 & ":" & "B" & RandomExercise + 1).Font.Bold = True
Range("A" & RandomExercise + 1 & ":" & "B" & RandomExercise + 1).Font.ColorIndex = 3

'Countdown from 20 minutes to 0
SetCountDown RandomExercise

End Sub

Sub SetCountDown(TargetCellRow As Integer)

Dim MinsRemaining As Integer
Dim iMins As Integer
MinsRemaining = 20

For iMins = MinsRemaining To 0 Step -1
    Range("C" & TargetCellRow + 1).Value = iMins & " mins"
    Application.Wait (Now + TimeValue("0:01:00"))
Next iMins

End Sub

Finally, on your spreadsheet you will need a way of starting the code.

Select View > Toolbers > Forms and then from the menu click Button and draw it anywhere on your spreadsheet. In the Assign Macro dialog box you should see 'StartExercise' as an option. Select this option and click ok.

Now when you click your button you should see an exercise and number of reps become highlighted in bold, red font and '20 mins' appear next to it. This will then countdown to 0 mins. If you then click the button you can start all over again with a random exercise.

Hope this helps.