writing to a cell takes AGES

[kgkev]

I'm trying to test a theory on winning at roulette.

It looks like the theory has holes in it but my code I have put together does too.

Basically you bet on either black or red a very small %age of the money available to you. if you win you repeat. if you loose you double the wager.

My code has proved this does not work unless you have a big pot of money to begin with. or gamble tiny amounts of money at a time.


Running 10,000 games through VBA takes second but if I try and record the results to excel it slows down to about 1 second per game. Shown in bold.

Can you look at my code and see if you can see why?

Sub rouletteBlack()
Application.ScreenUpdating = False
Range("M1:N56000").ClearContents
Dim repeat_count As Single
Dim Current_amount As Single
Dim End_amount As Single
Dim wager As Single
Dim lower_wager As Single
Dim random_result As Integer
Dim game_number As Integer

Current_amount = Sheets("Sheet1").Range("B1")
repeat_count = Sheets("Sheet1").Range("B2")

lower_wager = 1
wager = 1
    
For game_number = 1 To repeat_count
    Current_amount = Current_amount - wager
    With Range("M56000").End(xlUp).Offset(1)
        .Value = wager
        .Offset(, 1).Value = Current_amount
    End With
    If Current_amount < 0 Then
        MsgBox "BUST    ---    " & game_number
        Exit Sub
    End If
    random_result = randbetween(0, 36)
    If random_result > 18 Then
        Current_amount = Current_amount + (wager * 2)
        wager = lower_wager
    Else
        wager = wager * 2
        
    End If
Next game_number
Sheets("Sheet1").Range("B3").Value = Current_amount

End Sub

 

[RoryA]

because you are performing 20000 individual cell writes.

 

[kgkev]

I understand that it would take longer.

but it was taking around second per write. I let it run for about 1 minute and it had only got to repeat 20.

I have since closed the sheet and reopened it and it is as quick as expected now. about 12 seconds to do the 10,000.