A bug I can't seem to spot. Faulty logic? [duplicate] - vba

Question

Problem description:
Take a stack of coins all heads up. Upturn the topmost coin and then proceed: take the top 2 coins and upturn as a single stack (tail, head becomes when upturned and placed back on the stack tail, head (the two coins are flipped as if glued together)). Now in the same way flip the top 3 coins and place back on the stack (you get: tail, tail, head (and if there were 4 coins that would be tail, tail, tail, head). When you upturn the whole stack begin again with the first coin. Continue until you return to a stack with all heads up.
(Hope that's clear)
Can anybody see why this small program should fail? The example for me where I first notice an error is when count reaches 18 with a stack of 6 coins.
I placed a button on a spreadsheet and call FlippingCoins...
Sub FlippingCoins()
Call theStackOfCoins
Call theFlipping
End Sub
Sub theStackOfCoins()
Worksheets("Sheet3").Cells(1, 3).Select
Columns("A:b").Select
Selection.ClearContents
Range("a3").Select
Dim StackOfCoins As Integer
StackOfCoins = Worksheets("Sheet3").Cells(1, 3).Value
Dim row As Integer
row = 0
For theStack = 1 To StackOfCoins
Worksheets("Sheet3").Cells(row + theStack, 1).Value = True
Next theStack
End Sub
Sub theFlipping()
Dim middleCoin As Integer
middleCoin = 0
Dim passes As Integer
passes = 0
Dim Fst As Integer
Fst = 0
Dim Lst As Integer
Lst = 0
Dim stack As Integer
stack = Worksheets("Sheet3").Cells(1, 3).Value
Dim Flip_x_coins As Integer
Flip_x_coins = 0
Dim count As Integer
count = 0
Dim Finished As Boolean
Finished = False
Reset:
Flip_x_coins = 1
For Flip_x_coins = 1 To stack
Worksheets("Sheet3").Cells(1, 4).Value = Flip_x_coins
count = count + 1
If Flip_x_coins = 1 Then
Worksheets("Sheet3").Cells(1, 1).Value = Not (Worksheets("Sheet3").Cells(1, 1).Value)
Else
passes = Int(Flip_x_coins) / 2
Fst = 1
Lst = Flip_x_coins
For pass = 1 To passes
If Worksheets("Sheet3").Cells(Fst, 1).Value = Worksheets("Sheet3").Cells(Lst, 1).Value Then
Worksheets("Sheet3").Cells(Fst, 1).Value = Not (Worksheets("Sheet3").Cells(Fst, 1).Value)
Worksheets("Sheet3").Cells(Lst, 1).Value = Not (Worksheets("Sheet3").Cells(Lst, 1).Value)
End If
Fst = Fst + 1
Lst = Flip_x_coins - 1
Next pass
If Flip_x_coins Mod 2 > 0 Then
middleCoin = (Flip_x_coins + 1) / 2
Worksheets("Sheet3").Cells(middleCoin, 1).Value = Not (Worksheets("Sheet3").Cells(middleCoin, 1).Value)
End If
End If
For testComplete = 1 To stack
If Worksheets("Sheet3").Cells(testComplete, 1).Value = False Then
Finished = False
Exit For
Else
Finished = True
End If
Next testComplete
Worksheets("Sheet3").Cells(1, 2).Value = count
If Finished = True Then
Exit For
End If
MsgBox "Next."
If Flip_x_coins = stack Then
GoTo Reset
End If
Next Flip_x_coins
End Sub
Thanks in advance
Regards

Answer 1

In the For pass = 1 To passes loop, Lst = Flip_x_coins - 1 is wrong.
It should be: Lst = Lst - 1
On pass 18 with 6 coins, the macro compares rows 1 and 6 followed by rows 2 and 5 followed by rows 3 and 5. Obviously the last comparison should be between rows 3 and 4 instead.
I hope this isn't homework because there are lots of other problems with the macro. For example:
no Option Explicit at the start of the macro. This has allowed you to use three variables which you haven't declared - theStack, pass, testComplete
incorrect rounding. Given that Flip_x_coins is of Integer type, passes = Int(Flip_x_coins) / 2 is nonsense. Try passes = Int(Flip_x_coins / 2) instead
using Goto is generally a bad idea. It has some use in VBA for error handling but, in this case, you could easily use a Do Until finished ... Loop construct instead

Answer 2

I suspect this
Fst = Fst + 1
Lst = Flip_x_coins - 1
Next pass
should be
Fst = Fst + 1
Lst = Lst - 1
Next pass

Answer 3

Sub Flip()
Dim rw As Range
Dim numCoins As Integer
Dim iCoins As Integer, iCoin As Integer, flipCoins As Integer
Dim v
numCoins = 6
Set rw = Sheet1.Range("B2").Resize(1, numCoins) 'all start as "TRUE"
rw.Value = True
Do
For flipCoins = 1 To numCoins
For iCoin = 1 To numCoins
If iCoin <= flipCoins Then
v = Not rw.Cells(flipCoins - (iCoin - 1)).Value
Else
v = rw.Cells(iCoin).Value
End If
rw.Offset(1, 0).Cells(iCoin).Value = v
Next iCoin
Set rw = rw.Offset(1, 0)
rw.EntireRow.Cells(1).Value = "Flipped " & flipCoins
If Application.CountIf(rw, "FALSE") = 0 Then
Debug.Print "All Heads at row " & rw.Row
Exit Do
End If
Next flipCoins
Loop While rw.Row < 1000 'don't go on for ever...
End Sub