How to Auto-increment a cell value at user defined periodic interval?

Hi friends,
Can you please help me with this problem?

Say, cell A2 has value 5.
I want to auto increment A2 by 1 every 3 seconds.

How to achieve this? I tried below code I found over net, but it didn't do anything.

Sub CellTimer()

    Sheet1.Range("A2").Value = 5
    Do
        Application.Wait (Now() + TimeValue("0:00:03"))
        Sheet1.Range("A2").Value = Sheet1.Range("A2").Value + 1
    Loop

End Sub

Subsequently, once above problem is solved... I want Excel to take Auto increment interval from another cell. SO, once I change that cell value, interval will change and I do not need to change VBA module.

Thanks