Do until loop in vba - vba

Question

I written a vba where when i roll 6000 times dice, it will count the number of 1's rolled 2's rolled and so on until number of 6's
Private Sub CommandButton2_Click()
i = 6000
Do Until i < 0
n = Int(1 + Rnd * (6 - 1 + 1))
TextBox1.Text = Range("A1")
TextBox2.Text = Range("A2")
TextBox3.Text = Range("A3")
TextBox4.Text = Range("A4")
TextBox5.Text = Range("A5")
TextBox6.Text = Range("A6")
If n = 1 Then
Range("A1") = Range("A1") + n
ElseIf n = 2 Then
Range("A2") = Range("A2") + n / 2
ElseIf n = 3 Then
Range("A3") = Range("A3") + n / 3
ElseIf n = 4 Then
Range("A4") = Range("A4") + n / 4
ElseIf n = 5 Then
Range("A5") = Range("A5") + n / 5
ElseIf n = 6 Then
Range("A6") = Range("A6") + n / 6
End If
i = i - 1
Loop
End Sub
It works fine but the problem is it loads so slow, is there a way to fasten this code ?

Answer 1

Please try this code. It will give the result instantly.
Private Sub CommandButton2_Click()
Dim Arr(1 To 6) As Integer
Dim n As Integer ' random number: 1 to 6
Dim i As Long ' loop counter: turns
Randomize
For i = 1 To 6000
n = Int(1 + Rnd * (6 - 1 + 1))
Arr(n) = Arr(n) + 1
Next i
Range("A1").Resize(UBound(Arr)).Value = Application.Transpose(Arr)
For i = 1 To UBound(Arr)
Me.Controls("TextBox" & i).Value = Arr(i)
Next i
End Sub
The interaction between text boxes and worksheet cells isn't clear. It's easy to establish in any way you want.

Answer 2

Option Explicit
Private Sub CommandButton2_Click()
Dim i As Long
Dim n As Long
Dim results As Variant
results = Array(0, 0, 0, 0, 0, 0)
' read results from cells A1 - A6
For i = 1 To 6
results(i - 1) = Cells(1, i).Value
Next i
' roll the dice 6000 times
For i = 1 To 6000
n = Int(Rnd * 6)
results(n) = results(n) + 1
Next i
' write results to cells A1 - A6
For i = 1 To 6
Cells(1, i).Value = results(i - 1)
Next i
End Sub