Do While (Entire) Row Is Empty

[Dim User As New]

Hi All,

I have some code that checks a series of worksheets in a workbook for specific errors based on indicators in the field heading and then outputs dynamic hyperlinks to the cells with trapped errors in an error report. I'm having a problem with the Do While loop that I'm using to comb each applicable column though. Right now the loop is going while the next 25 rows in the column are not empty, but I want the loop to STOP when it reaches a row that is completely empty (all adjacent cells) instead.

Here is my code so far:

' Loop through all worksheets except "Instructions" and "EDE_Appendix"
For Each Worksheet_Loop In ThisWorkbook.Worksheets
If (Worksheet_Loop.Name <> "Instructions" _
And Worksheet_Loop.Name <> "EDE_Appendix") Then

' Select starting range on active worksheet and define right-most column
ActiveSheet.Range("A9").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.End(xlToRight).Select
i = ActiveCell.Column
ActiveSheet.Range("A9").Select

' Loop through the applicable columns
For Column_Count = 0 To i

' Loop through the active column
Active_Row = ActiveCell.Row
Active_Column = ActiveCell.Column
Do While Not (IsEmpty(Cells(Active_Row, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 1, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 2, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 3, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 4, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 5, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 6, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 7, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 8, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 9, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 10, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 11, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 12, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 13, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 14, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 15, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 16, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 17, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 18, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 19, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 20, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 21, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 22, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 23, ActiveCell.Column)) = False _
And Not IsEmpty(Cells(Active_Row + 24, ActiveCell.Column)) = False)
ActiveCell.Offset(1, 0).Select
Active_Row = ActiveCell.Row
Active_Column = ActiveCell.Column
Header_Value = Cells(9, Active_Column).Value

' IF field values need to be unique but are not THEN render cell blue

' IF actual length is greater than expected length THEN render cell green

' IF data type mismatch exists THEN render cell yellow

' IF field values are required but are null THEN render cell red

Loop
Range("A9").Offset(0, Column_Count).Select
Next Column_Count

ActiveSheet.Range("A8").Select
End If
Next

I've tried multiple approaches including referencing specific ranges and different variations of the loop to no avail... There has to be a more efficient way of going about this, but I keep getting caught in the loop offsetting to the next row... Any suggestions that will work with the rest of my code?

I'm using Excel 2010.

Thank you in advance!

-DUAN

 

[Dim User As New]

bump

 

[sous2817]

Rather than that long AND string, why not just do a Application.Worksheetfunction.COUNTA on the range. If that's 0, then you know it's empty and you can exit the loop.

 

[jasonb75]

Welcome to the board!

Is there anything below the empty row that you're testing for?

If not then try

Sub test()
Dim lrow As Long, lcol As Long, acell As Range, ws As Worksheet
    lrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lcol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For Each ws In ThisWorkbook
    If ws.Name <> "Instructions" And ws.Name <> "EDE_Appendix" Then
        With ws
            For Each acell In .Range("A9", .Cells(lrow, lcol))
                ' IF field values need to be unique but are not THEN render cell blue
                ' IF actual length is greater than expected length THEN render cell green
                ' IF data type mismatch exists THEN render cell yellow
                ' IF field values are required but are null THEN render cell red
            Next
        End With
    End If
Next
End Sub

You don't need to select every sheet / cell, doing so will only slow your code down.

 

[Dim User As New]

Thank you both for your replies; much appreciated!

Sous2817 - That is along the lines of what I was looking for, but within the context of my pre-existing loop structure the final row (the blank row) is still being "checked". The problem is that one of my validation criteria checks for null vlaues in required fields so it's trapping cells in that final row where the field heading specifies required values. Any ideas how I can refine my loop so that does not "check" that final row?

jasonb75 - I appreciate your insight, but it's a bit more expansive than that. I do need to check every worksheet (aside for those I'm not checking that is) and I'm not currently checking every cell which you will note if you closely examine the loop structure.

 

[Dim User As New]

Got it:

Do While Application.WorksheetFunction.CountA(Range(Cells(Active_Row + 1, 1), Cells(Active_Row + 1, 200))) <> 0

...did the trick!

***Thanks again Sous2817 for the idea***

-DUAN

 

[jasonb75]

jasonb75 - I appreciate your insight, but it's a bit more expansive than that. I do need to check every worksheet (aside for those I'm not checking that is) and I'm not currently checking every cell which you will note if you closely examine the loop structure.

Not sure I get you there, the code I suggested would cover all sheets bar the specified exceptions, restricted to the cells in the specified range.

I did just note however that I have a couple of lines out of sequence that would work with incorrect ranges, it should be

Sub test()
Dim lrow As Long, lcol As Long, acell As Range, ws As Worksheet
    For Each ws In ThisWorkbook
    If ws.Name <> "Instructions" And ws.Name <> "EDE_Appendix" Then
        With ws
            lrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lcol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            For Each acell In .Range("A9", .Cells(lrow, lcol))
                ' IF field values need to be unique but are not THEN render cell blue
                ' IF actual length is greater than expected length THEN render cell green
                ' IF data type mismatch exists THEN render cell yellow
                ' IF field values are required but are null THEN render cell red
            Next
        End With
    End If
Next
End Sub