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

#### divuraj

##### Board Regular
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.

Thanks,
divuraj.

### Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

#### MickG

##### MrExcel MVP
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
Code:
``````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

##### MrExcel MVP
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

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

#### mikerickson

##### MrExcel MVP
This method avoids looping
Code:
``````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

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

Divs.

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,167,960
Messages
5,856,525
Members
431,820
Latest member
Tori Murphy

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back