VERY SLOW Do While Loop Macro

[cocacrave]

Hi,
I have a macro that looks like this:

Sub btnPercent()

    Dim r As Integer, c As Integer
    r = 5
    c = 47
    
    Dim hand1 As Range, hand2 As Range, hand3 As Range, hand4 As Range
    Dim flop1 As Range, flop2 As Range, flop3 As Range, turn As Range, river As Range
    Set hand1 = Range("B2")
    Set hand2 = Range("D2")
    Set hand3 = Range("F2")
    Set hand4 = Range("H2")
    Set flop1 = Range("L2")
    Set flop2 = Range("N2")
    Set flop3 = Range("P2")
    Set turn = Range("R2")
    Set river = Range("T2")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With Sheets("compiler")
        Do While .Cells(r, c) <> vbNullString
            Select Case Mid(.Cells(r, c), 1, 2)
                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                    .Cells(r, c + 1) = vbNullString
                Case Else
                    Select Case Mid(.Cells(r, c), 3, 2)
                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                            .Cells(r, c + 1) = vbNullString
                        Case Else
                            Select Case Mid(.Cells(r, c), 5, 2)
                                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                    .Cells(r, c + 1) = vbNullString
                                Case Else
                                    Select Case Mid(.Cells(r, c), 7, 2)
                                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                            .Cells(r, c + 1) = vbNullString
                                        Case Else
                                            .Cells(r, c + 1) = "+"
                                    End Select
                            End Select
                    End Select
            End Select
            c = c + 3
            Select Case .Cells(r, c)
                Case vbNullString
                    c = 47
                    r = r + 1
            End Select
        Loop
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

It takes about a minute to finish the macro loop.
It is going through a table of 270,725 cells.
Is there any way to speed this up?

[PCI]

In general manner to go faster avoid direct access to cells.
Copy the complete used range to an array, then treat the data inside the array, then copy back the modified array to the range.
If you could attach a short sample of your data, it will possible to prepare an update

[TnTinMN]

In general, I agree with PCI concerning using an array. However, you may get adequate performance by just restructuring your variable definitions a bit.

You are defining most of the variables a Ranges.

   Dim hand1 As Range, hand2 As Range, hand3 As Range, hand4 As Range
   Dim flop1 As Range, flop2 As Range, flop3 As Range, turn As Range, river As Range

However all you appear to be interested in is their respective text value. These ranges all are from row 2 and are not modified by the code, hence their values remain the same during execution. To prevent repeated access to these Ranges in the "Select Case" statements, these variable can be redefined as String.

Sub btnPercent()

    Dim r As Integer, c As Integer
    r = 5
    c = 47
    Dim hand1 As String, hand2 As String, hand3 As String, hand4 As String
    Dim flop1 As String, flop2 As String, flop3 As String, turn As String, river As String
    hand1 = Range("B2").Text
    hand2 = Range("D2").Text
    hand3 = Range("F2").Text
    hand4 = Range("H2").Text
    flop1 = Range("L2").Text
    flop2 = Range("N2").Text
    flop3 = Range("P2").Text
    turn = Range("R2").Text
    river = Range("T2").Text
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With Sheets("compiler")
        Dim testString As String
        Do
            testString = .Cells(r, c).Text
            If testString = vbNullString Then Exit Do
            
            Select Case Mid(testString, 1, 2)
                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                    .Cells(r, c + 1) = vbNullString
                Case Else
                    Select Case Mid(testString, 3, 2)
                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                            .Cells(r, c + 1) = vbNullString
                        Case Else
                            Select Case Mid(testString, 5, 2)
                                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                    .Cells(r, c + 1) = vbNullString
                                Case Else
                                    Select Case Mid(testString, 7, 2)
                                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                            .Cells(r, c + 1) = vbNullString
                                        Case Else
                                            .Cells(r, c + 1) = "+"
                                    End Select
                            End Select
                    End Select
            End Select
            c = c + 3
            Select Case .Cells(r, c).Text
                Case vbNullString
                    c = 47
                    r = r + 1
            End Select
        Loop
      End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[cocacrave]

TnTinMN,
Thanks for your help. I tried it out but the macro is now 3x slower. Original took 1.5min, yours took 4.5min.

PCI,
I tried to make it in an array, and I've done that part successfully. However, I'm having trouble looping through these array.

Sub btnPercent()
    
    Dim arrDead(1 To 9) As String
    arrDead(1) = Range("B2")
    arrDead(2) = Range("D2")
    arrDead(3) = Range("F2")
    arrDead(4) = Range("H2")
    arrDead(5) = Range("L2")
    arrDead(6) = Range("N2")
    arrDead(7) = Range("P2")
    arrDead(8) = Range("R2")
    arrDead(9) = Range("T2")
    
    Dim arrClass(5 To 16111, 47 To 118) As String
    Dim r As Integer, c As Integer
    
    For r = 5 To 16111
        For c = 47 To 118
            arrClass(r, c) = Sheets("compiler").Cells(r, c)
        Next c
    Next r
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    r = 5
    c = 47
    
    With Sheets("compiler")
        Do While arrClass(r, c) <> vbNullString
            Select Case Mid(arrClass(r, c), 1, 2)
                Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                    .Cells(r, c + 1) = vbNullString '**
                Case Else
                    Select Case Mid(arrClass(r, c), 3, 2)
                        Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                            .Cells(r, c + 1) = vbNullString '**
                        Case Else
                            Select Case Mid(arrClass(r, c), 5, 2)
                                Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                    .Cells(r, c + 1) = vbNullString '**
                                Case Else
                                    Select Case Mid(arrClass(r, c), 7, 2)
                                        Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                            .Cells(r, c + 1) = vbNullString '**
                                        Case Else
                                            .Cells(r, c + 1) = "+" '**
                                    End Select
                            End Select
                    End Select
            End Select
            c = c + 3
            Select Case arrClass(r, c) '*
                Case vbNullString
                    c = 47
                    r = r + 1
            End Select
        Loop
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

I've tried to run it but it ran over 10+ min when I cancelled it.
When I cancelled it, it gave me an error "Run-Time error '9': Subscript out of range" and highlighted line "Select Case arrClass(r, c)"
I added "*" comment on the highlighted line.

Also, I added "**" comment on lines ".Cells(r, c + 1) = vbNullString" lines where I don't know if that is the reason why it is taking so long.
Is there a way to make arrClass(r, c + 1) = vbNullString and when loop finishes, it updates the table to equal the array?

Thanks guys

[TnTinMN]

TnTinMN,
Thanks for your help. I tried it out but the macro is now 3x slower. Original took 1.5min, yours took 4.5min.

Oops. I used the Text property on the Range and that is slow as it needs to format the value.

This is probably not needed, but here is the revised code in case you want to test it against the array method. I also change the Mid function to use MID$ as that is supposedly faster.

Sub btnPercent()
    Dim r As Integer, c As Integer
    r = 5
    c = 47
    Dim hand1 As String, hand2 As String, hand3 As String, hand4 As String
    Dim flop1 As String, flop2 As String, flop3 As String, turn As String, river As String
    hand1 = Range("B2").Value
    hand2 = Range("D2").Value
    hand3 = Range("F2").Value
    hand4 = Range("H2").Value
    flop1 = Range("L2").Value
    flop2 = Range("N2").Value
    flop3 = Range("P2").Value
    turn = Range("R2").Value
    river = Range("T2").Value
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With Sheets("compiler")
        Dim testString As String
        Do
            testString = .Cells(r, c).Value
            If testString = vbNullString Then Exit Do
            
            Select Case Mid$(testString, 1, 2)
                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                    .Cells(r, c + 1) = vbNullString
                Case Else
                    Select Case Mid$(testString, 3, 2)
                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                            .Cells(r, c + 1) = vbNullString
                        Case Else
                            Select Case Mid$(testString, 5, 2)
                                Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                    .Cells(r, c + 1) = vbNullString
                                Case Else
                                    Select Case Mid$(testString, 7, 2)
                                        Case Is = hand1, hand2, hand3, hand4, flop1, flop2, flop3, turn, river
                                            .Cells(r, c + 1) = vbNullString
                                        Case Else
                                            .Cells(r, c + 1) = "+"
                                    End Select
                            End Select
                    End Select
            End Select
            c = c + 3
            Select Case .Cells(r, c).Value
                Case vbNullString
                    c = 47
                    r = r + 1
            End Select
        Loop
      End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

[Sa DQ]

Redim Arr(1 to 1, 1 to 10) As String
 Dim J%
 
 For J = 2 To 20 Step 2
    Arr(1, J/2)= Cells(2, J).Value 
 Next j 

[cocacrave]

Sa DQ,
Sorry, I don't understand that code... How does it apply here?

[cocacrave]

I figured it out how to array and put back to sheet. And now it takes 7seconds (from 1m30sec).

Sub btnPercent()
    
    Dim arrDead(1 To 9) As String
    arrDead(1) = Range("B2")
    arrDead(2) = Range("D2")
    arrDead(3) = Range("F2")
    arrDead(4) = Range("H2")
    arrDead(5) = Range("L2")
    arrDead(6) = Range("N2")
    arrDead(7) = Range("P2")
    arrDead(8) = Range("R2")
    arrDead(9) = Range("T2")
    
    Dim arrClass(5 To 16111, 47 To 118) As String
    Dim r As Integer, c As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With Sheets("compiler")
        For r = 5 To 16111
            For c = 47 To 118
                arrClass(r, c) = .Cells(r, c)
            Next c
        Next r
        
        For r = 5 To 16111
            For c = 47 To 118 Step 3
                Select Case arrClass(r, c)
                    Case Is <> vbNullString
                        Select Case Mid(arrClass(r, c), 1, 2)
                            Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                arrClass(r, c + 1) = vbNullString
                            Case Else
                                Select Case Mid(arrClass(r, c), 3, 2)
                                    Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                        arrClass(r, c + 1) = vbNullString
                                    Case Else
                                        Select Case Mid(arrClass(r, c), 5, 2)
                                            Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                                arrClass(r, c + 1) = vbNullString
                                            Case Else
                                                Select Case Mid(arrClass(r, c), 7, 2)
                                                    Case Is = arrDead(1), arrDead(2), arrDead(3), arrDead(4), arrDead(5), arrDead(6), arrDead(7), arrDead(8), arrDead(9)
                                                        arrClass(r, c + 1) = vbNullString
                                                    Case Else
                                                        arrClass(r, c + 1) = "+"
                                                End Select
                                        End Select
                                End Select
                        End Select
                End Select
            Next c
        Next r
        
        .Range("AU5:DN16111") = arrClass()
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[PCI]

"I figured it out how to array and put back to sheet. And now it takes 7seconds (from 1m30sec)."
Good news
You could also see ( NOT TESTED here )
change

 Dim arrClass(5 To 16111, 47 To 118) As String

to

 
Dim arrClass()

and use

 arrClass() = range(.cells(?,?),.cells(?,?))   'it means leave VBA  to prepare the size

and after see with

for c = LBound(arrClass,1) to UBound(arrClass,1)

for r = LBound(arrClass,2) to UBound(arrClass,2)

In the way to did you save memory but perhaps a bit slower