count blank cells based on a condition in a range using VBA

[divuraj]

Hi,

i have few blank cells in column A. i find the last row containing data in column A and then i am trying to find the blank cells in column A which works fine.

once i find a blank cell in column A, i would need to select the range of cells till i find the cell with values,basically count the number of blank cells within a range.

now within this range i have values in column E, i need to find Min of these values and delete all blank rows which are not Min.

for eg, i identified first blank cell in A72, so i go to E71 and select the range of cells in E column till i find a non blank cell in A column which is E71:E72 in this case. i have 296 in E71 and 359 in E72, so i find the Min which is 296, so i delete the row which has 359.

Hope this explains.

please help.

Thanks,
divuraj.

 

[MickG]

Hi Try this:-
The code deletes all rows,whose Row in column "A" is empty, except those rows whose column "E" value is a minimium Values within each set of empty rows in column "A".
Single Empty rows are ignored

Dim c As Integer, Last As Integer, oBk As Integer, oMin(), oFd As Integer
Dim Nd As Integer, St As Integer, MnRng As Integer, oMn As Double
Last = Range("a" & Rows.Count).End(xlUp).Row
For oBk = Last To 2 Step -1
        If Cells(oBk, 1) = "" Then
    Do While Cells(oBk, 1) = ""
        If oBk = 1 Then Exit Sub
            c = c + 1
                ReDim Preserve oMin(c)
            If c = 1 Then
                  Nd = oBk
                Else
                     St = oBk
                    End If
                 oMin(c) = Cells(oBk, "E")
                      oBk = oBk - 1
             Loop
    oMn = WorksheetFunction.Min(oMin)
If c > 1 Then
     MnRng = Range(Cells(St, 5), Cells(Nd, 5)).Row

    For oFd = Nd To St Step -1
        If Not Cells(oFd, "E") = oMn Then
             Rows(oFd).EntireRow.Delete
            End If
        Next oFd
    End If
End If
c = 0
Next oBk

Regards Mick

 

[erik.van.geit]

Hi, divuraj,

Your explanation sounds a bit confusing.
I am quite sure that you can solve this using autofilter (within code). That would avoid loops. Can you provide some data to work with?

kind regards,
Erik

 

[divuraj]

Thanks all...special thanks to Mick...the code works for me.

 

[mikerickson]

This method avoids looping

Dim minVal As Double

On Error Resume Next
With ActiveSheet.Range("E:E")
    With Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
        With .Offset(0, -4).SpecialCells(xlCellTypeBlanks)
            With Application.Intersect(.EntireRow, .Offset(0, 4).EntireColumn)
                minVal = Application.Min(.Cells)
            End With
            .FormulaR1C1 = "=1/--(RC[4]=" & minVal & ")"
            .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
            .ClearContents
        End With
    End With
End With
On Error GoTo 0

 

[divuraj]

Sure Mick, I will try this and get back to you if i get any errors.

Thanks for your help !

Divs.