Question : VBA Inconsistent results using Application.CountA

Starting at the top of the active sheet, I'm trying to delete all empty rows, then when I find a non-empty row, I want to identify the column which has a date in it. The trouble is that the code:

If Application.CountA(Rows(rownum)) = 0 Then

is acting inconsistently. If the row is blank, I would expect this code to identify it. Sometimes it does, but it more consistently identfies empty rows when I use the following code:

If Application.CountA(Rows(rownum)) = 1 Then

Am I doing something wrong? Is there a better way to accomplish this? Here is the full snippet of code in which the statement above appears:

    colnum = 1
    rownum = 1
    DateFound = False
    Do While DateFound = False
        If Application.CountA(Rows(rownum)) = 0 Then
            Rows(rownum).Delete
        ElseIf IsDate(ActiveSheet.Cells(rownum, colnum)) Then
            Sheet4.Cells(1, 2) = colnum
            DateFound = True
        Else
            colnum = colnum + 1
        End If
    Loop

Answer : VBA Inconsistent results using Application.CountA

taduh,

You're right!  Cut&Paste error...

Here's the revised routine:

Sub DeleteNonDateRows()
Dim colnum As Long, rownum As Long, DateFound As Boolean, delrng As Range
   
Application.ScreenUpdating = False
   
rownum = 1
DateFound = False
   
Do While DateFound = False
    For colnum = 1 To ActiveSheet.UsedRange.Columns.Count
        If IsDate(ActiveSheet.Cells(rownum, colnum)) Then
            Sheet4.Cells(1, 2) = colnum
            DateFound = True
            Exit For
        End If
    Next colnum
    If Not DateFound Then
        If Not delrng Is Nothing Then
            Set delrng = Union(delrng, Rows(rownum))
        Else
            Set delrng = Rows(rownum)
        End If
    End If
    rownum = rownum + 1
    If rownum > ActiveSheet.UsedRange.Rows.Count Then Exit Do
Loop
   
If Not delrng Is Nothing Then
    delrng.EntireRow.Delete
End If
   
Application.ScreenUpdating = True
   
End Sub

Jim
Random Solutions  
 
programming4us programming4us