Excel Do...Loop

[TU TRAN]

The below script did not work as expected. For a Do..Loop, We expect just one
click and DONE, but somehow too many clicks are required.

Option Base 1

' TU TRAN'S PHASE 1 FLOW CHART
'
' STEP 1 Scanning and storing empty cells addresses in variable array
"mtCellHolder"
' STEP 2 Looping through each element of mtCellHolder to get its
available values:
' - if only 1 value available, write it to the empty cell.
' - if multiple values availble, store them in a place holder
"valueHolder".
' STEP 3 Repeat 1 and 2 UNTIL all empty cells have 2 or more available
values.

Sub availVAL()

Dim vHOR As Variant ' Variant/Variant = Empty
Dim vVER As Variant ' Variant/Variant = Empty
Dim vGrid As Variant ' Variant/Variant = Empty
Dim mtCellHolder As Variant ' Variant/Variant = Empty

Dim str As String ' Variant/String = ""

Dim i As Integer ' Variant/Integer
Dim j As Integer

Dim num2check As Integer

Dim valueHolder() ' Variant/Variant = Empty
Dim numHolder() ' Variant/Variant = Empty

Dim oCollection As New Collection, vItem As Variant

Dim k As Integer
Dim numVal As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer

Dim rgSudoku As Range ' Variant/Object = Nothing

Set rgSudoku = Sheets(1).Range("$A$1:$I$9")
numOfBlankCells = Application.CountIf(rgSudoku, "")

Do

scanEmptyCell:

On Error GoTo SubExit

'MsgBox "initial numOfBlankCells" & numOfBlankCells

If numOfBlankCells <> 0 Then

Call mtCellScanner(rgSudoku, mtCellHolder)
For i = 1 To UBound(mtCellHolder) ' i < 81 is the Index for vElm

vElm = mtCellHolder(i) ' emty cell address
vElm=$C$1 =Empty

' AVAILABLE VALUES RECORDING LOOP FOR AN EMPTY CELL (vElm)

j = 1 ' j <= 9 is elements to
numHolder
For num2check = 1 To 9 ' num2check is
value2check

scanROW:
Call vRow(vElm, vHOR) '<> Empty Then '
call Function
If Not ArrayHasItem(vHOR, num2check) Then ' call
Function
GoTo scanCOLUMN
Else
GoTo Skip1
End If

scanCOLUMN:

Call vCol(vElm, vVER) 'Then ' call Function
If Not ArrayHasItem(vVER, num2check) Then
GoTo scanBOX
Else
GoTo Skip1
End If

scanBOX:
Call vBox(vElm, vGrid) 'Then ' call Function
If Not ArrayHasItem(vGrid, num2check) Then
ReDim Preserve numHolder(j)
numHolder(j) = num2check ' numHolder(j =
element 1 to 9),
'MsgBox " vElm = " & vElm & " " & "num2check: " &
num2check ' num2check = value 1 to 9
j = j + 1 ' next element
of numHolder
End If
'End If ' vBox

Skip1:
Next num2check

write1:
If j - 1 = 1 Then
Worksheets("Sheet1").Range(vElm) = numHolder
'mtCellHolder.RemoveItem (i) 'Obj required (Error 424)
'MsgBox "current numOfBlankCells" & numOfBlankCells
'GoTo scanEmptyCell 'update
emptyCellHolder
Else

ReDim Preserve valueHolder(i)
valueHolder(i) = numHolder '
valueHolder(i)(numHolder(j), num2check)

End If

Next i ' For i = 1 To UBound(mtCellHolder)
Else
MsgBox " Congratulation! All empty cells are filled up"
Exit Sub
End If ' If numOfBlankCells <> 0

write2:

' TU TRAN PHASE 2 STRATEGY:
' STEP1:
' - Associate valueHolder with mtCellHolder
' STEP 2:
' 2a -Retrieve vElmValue
' 2b -Calling Functions to write value to vElm
' If one of values is unique for both row and column, write that value
to vElm,
' proceed to next vElm by looping back 2a
' If Len(vElm) <=3 then
' Call Function sameRowAs_vElm to write to vElm if any.
' proceed to next vElm by looping back 2a
' Else call Function sameColumnAs_vElm to write to vElm if any
' proceed to next vElm by looping back 2a
' Else call Function sameBoxWith_vElm to write to vElm if any
' proceed to next vElm by looping back 2a

' Notes:
' 1- Do ... Loop ???
' Expected just one click and DONE, But somehow many clicks are required
' If "On Error GoTo SubExit" is removed, Macro stops at multiple
breakpoints
'
' 2- Higher difficult levels, which requires trial and error method, will
not work as of now.
' (For example: if $D$1=6 is removed)
' Additional logic is under scrutiny

' associate valueHolder(i)(j) with mtCellHolder(i) ***** START
For k = 1 To UBound(valueHolder)

vElm = mtCellHolder(k)
'MsgBox "vElm = " & vElm
oCollection.Add k, CStr(vElm)

Next k '***** ***************************** END

' 2a -Retrieve vElmValue

For l = UBound(mtCellHolder) To 1 Step -1 ' l=Empty
vElm = mtCellHolder(l) ' vElm=Empty

If CollectionItemExists(CStr(vElm), oCollection, vItem) Then
'MsgBox "vElm : " & vElm & " " & "Returned: " & vItem
On Error Resume Next
vElmValue = ""
vArr = valueHolder(vItem)
For numVal = 1 To 9
If ArrayHasItem(vArr, numVal) Then
'MsgBox "vElmValue " & numVal
vElmValue = vElmValue & numVal
End If
Next
' 2b -Calling Functions to write value to vElm
'MsgBox "vElm : " & vElm & " " & "vElmValue " & vElmValue
If cross_Unique(vElm, oCollection, valueHolder) Then GoTo
Advance

If Len(vElmValue) = 2 Then

If sameRowAs_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

If sameColumnAs_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

If sameBoxWith_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

Else
If Len(vElmValue) = 3 Then

If sameRowAs_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

If sameColumnAs_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

If sameBoxWith_vElm(vElm, vElmValue, oCollection,
valueHolder) Then GoTo Advance

End If ' Len(vElmValue) = 3
End If ' Len(vElmValue) = 2
End If 'CollectionItemExists(CStr(vElm), oCollection, vItem)

Advance:

Next 'For l = UBound(mtCellHolder)

Loop While numOfBlankCells <> 0

MsgBox "Bravo! tres bien"
'
===============================================================================
SubExit:
On Error GoTo 0

End Sub