Do while loop doesnt work on big data file - vba

Question

I have big data file on excel, the file has 6930 rows and 8 columns,
the 8 column has percents (0%, 4%, 16%, 18%, 19% and etc..)
I tried to do a macro that paint all the rows that the percent in them are bigger then 18%, and it doesn't work.
The file start from row 3, so rows 1 and 2 are empty
The macro:
Sub Test_4
Dim i As Long
Dim countErr As Long
countErr = 0
i = 2
Do While Cells(i, 1) = ""
If Cells(i, 8).Value > 0.18 And IsNumeric(Cells(i, 8)) Then
Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 3
countErr = countErr + 1
End If
i = i + 1
Loop
If countErr > 0 Then
Sheets("test").Select
Range("E8").Select
Selection.Interior.ColorIndex = 3
Range("D8").Select
Selection.FormulaR1C1 = countErr
Else
Sheets("test").Select
Range("E8").Select
Selection.Interior.ColorIndex = 4
Sheets("test").Range("d8") = "0"
End If
End Sub

Answer 1

A Do While loop might be a bad idea if Column H ever has a blank value part way down, instead you could do this (This will add conditional formatting to each line):
Given this input:
Sub testit()
Dim LastRow As Long, CurRow As Long, countErr As Long
LastRow = Range("H" & Rows.Count).End(xlUp).Row
Cells.FormatConditions.Delete
With Range("A3:H" & LastRow)
.FormatConditions.Add Type:=xlExpression, Formula1:="=$H3>0.18"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Interior.ColorIndex = 3
.FormatConditions(1).StopIfTrue = False
End With
countErr = 0
Dim cel As Range
For Each cel In Sheets("NAME OF SHEET").Range("H3:H" & LastRow)
If cel.Value > 0.18 Then
countErr = countErr + 1
End If
Next cel
MsgBox "There are " & countErr & " rows greater than 18%"
End Sub
Running the code gives:
Error Testing:
Sub ErrorTesting()
Dim cel As Range, countErr As Long
countErr = 0
LastRow = Range("H" & Rows.Count).End(xlUp).Row
For Each cel In Range("H3:H" & LastRow)
On Error GoTo ErrHandle
If Not IsNumeric(cel.Value) Then
MsgBox cel.Address & " is the address of the non-numeric Cell"
End If
If cel.Value > 0.18 And IsNumeric(cel.Value) Then
countErr = countErr + 1
End If
Next cel
ErrHandle:
If Not cel Is Nothing Then
MsgBox cel.Address & " is the address and " & cel.Value & " is the value of the Error Cell"
End If
MsgBox countErr
End Sub

Answer 2

Try this (updated for error count):
Sub test()
Count = 0
i = 2
While Not IsEmpty(Cells(i, 8))
If Cells(i, 8).Value > 0.18 Then
Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 3
Count = Count + 1
End If
i = i + 1
Wend
//rows count bigger than 18% in worksheet "test"
Worksheets("test").Cells(1, 1).Value = "Rows count bigger than 18%"
Worksheets("test").Cells(1, 2).Value = Count
End Sub