Streamline VBA to select last row with data

[craving94509]

I have a sheet that I hand out to collect data. There is conditional formatting to color cells red or yellow depending on the type of data error.

I have the following code which works but is a bit slow. The number of rows can change in the worksheet and because of the way I have written the code it looks at the entire range A8:A5000 or B8:B5000 etc. I am hoping there is a way to find the last row with data and then perform the counts. In some cases there are as few as 10 rows and my calculations are taking way to long given the limited number of rows. In some cases the sheet might had 500 rows of data.

'Caluculate the nuber of errors (red & yellow cells) for column A
For Each cLoc In Range("A8:A5000")
If cLoc.DisplayFormat.Interior.Color = vbRed Or cLoc.DisplayFormat.Interior.Color = vbYellow Then LocError = LocError + 1
Next cLoc
Range("A7").Value = "Errors: " & LocError

'Caluculate the nuber of errors (red & yellow cells) for column B
For Each cSite In Range("B8:B5000")
If cSite.DisplayFormat.Interior.Color = vbRed Or cSite.DisplayFormat.Interior.Color = vbYellow Then SiteError = SiteError + 1
Next cSite
Range("B7").Value = "Errors: " & SiteError

Hoping someone can provide a better solution.

Mike
Excel 2016

 

[My Aswer Is This]

You should show us the entire script.
This is only a part of the script.

 

[craving94509]

Sorry.

'The following code is for the "Locations" worksheet
'This will update the error counts (red & yellow cells) for each column and for the entire worksheet
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MSG1 = MsgBox("By clicking yes the error counts will be updated" & vbNewLine & "for the whole sheet as well as each column." & vbNewLine & vbNewLine & "This could take some time depending on the amount of data within the worksheet." & vbNewLine & vbNewLine & "Would you like to continue updating the statistics?", vbYesNo, "Axxim Data Loading Utility")
If MSG1 = vbYes Then
Dim LocLoadG As Range, LocLoadGood As Long
Dim cLoc As Range, LocError As Long
Dim cSite As Range, SiteError As Long
Dim cStatus As Range, StatusError As Long
Dim cType As Range, TypeError As Long
Dim cDesc As Range, DescError As Long
Dim cCorrL As Range, CorrLError As Long
Dim cCorrDesc As Range, CorrDescError As Long
Dim cParentLoc As Range, ParentLocError As Long
Dim cPrior As Range, PriorError As Long
Dim cFailure As Range, FailureError As Long
Dim cSystem As Range, SystemError As Long
Dim LastRowA As Long
ActiveSheet.Unprotect Password:="ADLU2016"
Application.EnableEvents = False
On Error Resume Next
'Caluculate the nuber of cells with data that are not considered errors (red & yellow cells) for the entire worksheet and return the value to cell L1
For Each LocLoadG In Range("A8:K5000")
If LocLoadG.Interior.ColorIndex = xlNone And LocLoadG.DisplayFormat.Interior.Color <> vbRed And LocLoadG.DisplayFormat.Interior.Color <> vbYellow And LocLoadG.Value <> "" Then LocLoadGood = LocLoadGood + 1
Next LocLoadG
Range("L1").Value = LocLoadGood
'Caluculate the nuber of errors (red & yellow cells) for column A
For Each cLoc In Range("A8:A5000")
If cLoc.DisplayFormat.Interior.Color = vbRed Or cLoc.DisplayFormat.Interior.Color = vbYellow Then LocError = LocError + 1
Next cLoc
Range("A7").Value = "Errors: " & LocError
'Caluculate the nuber of errors (red & yellow cells) for column B
For Each cSite In Range("B8:B5000")
If cSite.DisplayFormat.Interior.Color = vbRed Or cSite.DisplayFormat.Interior.Color = vbYellow Then SiteError = SiteError + 1
Next cSite
Range("B7").Value = "Errors: " & SiteError
'Caluculate the nuber of errors (red & yellow cells) for column C
For Each cStatus In Range("C8:C5000")
If cStatus.DisplayFormat.Interior.Color = vbRed Or cStatus.DisplayFormat.Interior.Color = vbYellow Then StatusError = StatusError + 1
Next cStatus
Range("C7").Value = "Errors: " & StatusError
'Caluculate the nuber of errors (red & yellow cells) for column D
For Each cType In Range("D8:D5000")
If cType.DisplayFormat.Interior.Color = vbRed Or cType.DisplayFormat.Interior.Color = vbYellow Then TypeError = TypeError + 1
Next cType
Range("D7").Value = "Errors: " & TypeError
'Caluculate the nuber of errors (red & yellow cells) for column E
For Each cDesc In Range("E8:E5000")
If cDesc.DisplayFormat.Interior.Color = vbRed Or cDesc.DisplayFormat.Interior.Color = vbYellow Then DescError = DescError + 1
Next cDesc
Range("E7").Value = "Errors: " & DescError
'Caluculate the nuber of errors (red & yellow cells) for column F
For Each cCorrL In Range("F8:F5000")
If cCorrL.DisplayFormat.Interior.Color = vbRed Or cCorrL.DisplayFormat.Interior.Color = vbYellow Then CorrLError = CorrLError + 1
Next cCorrL
Range("F7").Value = "Errors: " & CorrLError
'Caluculate the nuber of errors (red & yellow cells) for column G
For Each cCorrDesc In Range("G8:G5000")
If cCorrDesc.DisplayFormat.Interior.Color = vbRed Or cCorrDesc.DisplayFormat.Interior.Color = vbYellow Then CorrDescError = CorrDescError + 1
Next cCorrDesc
Range("G7").Value = "Errors: " & CorrDescError
'Caluculate the nuber of errors (red & yellow cells) for column H
For Each cParentLoc In Range("H8:H5000")
If cParentLoc.DisplayFormat.Interior.Color = vbRed Or cParentLoc.DisplayFormat.Interior.Color = vbYellow Then ParentLocError = ParentLocError + 1
Next cParentLoc
Range("H7").Value = "Errors: " & ParentLocError
'Caluculate the nuber of errors (red & yellow cells) for column I
For Each cPrior In Range("I8:I5000")
If cPrior.DisplayFormat.Interior.Color = vbRed Or cPrior.DisplayFormat.Interior.Color = vbYellow Then PriorError = PriorError + 1
Next cPrior
Range("I7").Value = "Errors: " & PriorError
'Caluculate the nuber of errors (red & yellow cells) for column J
For Each cFailure In Range("J8:J5000")
If cFailure.DisplayFormat.Interior.Color = vbRed Or cFailure.DisplayFormat.Interior.Color = vbYellow Then FailureError = FailureError + 1
Next cFailure
Range("J7").Value = "Errors: " & FailureError
'Caluculate the nuber of errors (red & yellow cells) for column K
For Each cSystem In Range("K8:K5000")
If cSystem.DisplayFormat.Interior.Color = vbRed Or cSystem.DisplayFormat.Interior.Color = vbYellow Then SystemError = SystemError + 1
Next cSystem
Range("K7").Value = "Errors: " & SystemError
'Total the number of errors for each column and place the value in cells D1 & I1
'This is used to calculate the Error Correction Completion graph
Range("I1").Value = LocError + SiteError + StatusError + DescError + TypeError + CorrLError + CorrDescError + ParentLocError + PriorError + FailureError + SystemError
Range("D1").Value = "Total Errors:" & vbNewLine & Range("I1").Value
'Let the user know that the worksheet has been updated
MsgBox "Statistics have been successfully updated.", vbOKOnly, APPNAME
Application.EnableEvents = True
Else
Exit Sub
End If
ActiveSheet.Protect Password:="ADLU2016", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[HalfAce]

Just going by the code example you originally posted, does this help at all?

 'Caluculate the nuber of errors (red & yellow cells) for column A
'Find last used row in column A
LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
'Loop only through row 8 to LastRowA
For Each cLoc In Range("A8:A" & LastRowA)
If cLoc.DisplayFormat.Interior.Color = vbRed Or cLoc.DisplayFormat.Interior.Color = vbYellow Then LocError = LocError + 1
Next cLoc
Range("A7").Value = "Errors: " & LocError

'Caluculate the nuber of errors (red & yellow cells) for column B
'Find last used row in column B
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
'Loop through only row 8 to LastRowB
For Each cSite In Range("B8:B" & LastRowB)
If cSite.DisplayFormat.Interior.Color = vbRed Or cSite.DisplayFormat.Interior.Color = vbYellow Then SiteError = SiteError + 1
Next cSite
Range("B7").Value = "Errors: " & SiteError

EDIT: This will determine the last used row in each column before looping, and then only loop down to that row.

Hope it helps.

 

[My Aswer Is This]

There may also be more places to speed up your script. But to start with in every case where you have a line of code like this:
For Each cType In Range("D8:D5000")

You should use code like this:

By using Lastrow the script looks to the last row and does not always look to row 5,000

Dim Lastrowc As Long
Dim Lastrowd As Long
Lastrowc = Cells(Rows.Count, "C").End(xlUp).Row
Lastrowd = Cells(Rows.Count, "D").End(xlUp).Row
For Each cStatus In Range("C8:C" & Lastrowc)
For Each cType In Range("D8:D" & Lastrowd)

 

[craving94509]

Thank you very much. Just what I was looking for!!!

 

[My Aswer Is This]

Glad we were able to help you. Come back here to Mr. Excel next time you need additional assistance.

Thank you very much. Just what I was looking for!!!

 

[HalfAce]

Limiting it to just the used rows will speed it upsignificantly, but if speed is of the essence you could replace all those If,Or statements, using select case instead. I think that might be quicker.

 

[tonyyy]

Another, potentially faster, approach would be to eliminate the use of loops altogether. For example...

Dim LocError As Long
Dim LastRowA As Long
Dim rng As Range

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A8:A" & LastRowA)
LocError = WorksheetFunction.CountIfs(rng, ">20", rng, "<100")
Range("A7").Value = "Errors: " & LocError

The above uses the WorksheetFunction.Countifs method to count the number of cells in Column A that meet the criteria of >20 and <100. You would substitute the criteria with that from your Conditional Formatting criteria.

Cheers,

tonyyy