HELP! W/ Counting Data

[BIGTONE559]

I'm trying to count data and based on the criteria paste data into another portion of the spreadsheet. I'm having problems because there is a blank in the column of data that i've specified however it doesn't appear to go in order when it's executing the macro, and it also stops once it reaches the blank cell.

Sub Count_Check()

Dim Chkrange As Range
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim myCount As Integer
Dim destrow As Integer




destrow = 18














x = 5
y = 5
z = 18



Set Chkrange = Range("D5:D30")

For Each cell In Chkrange

If Application.WorksheetFunction.Countif(Range("D5:D30"), Cells(x, 4)) > 1 Or cell.Value = "" Then


MsgBox (Cells(x, 4))



Range(Cells(cell.Row, 1), Cells(cell.Row, 5)).Copy Destination:=Cells(destrow, 10)




x = x + 1

destrow = destrow + 1





End If



Next cell



End Sub

 

[JackDanIce]

Does this work?

Sub Count_Check()

Dim Chkrange As Range
Dim x As Integer, y As Integer, z As Integer, i As Integer
Dim myCount As Integer, destrow As Integer

destrow = 18
x = 5
y = 5
z = destrow

Set Chkrange = Range("D5:D30")

For Each Cell In Chkrange
    If Application.CountIf(Range("D5:D30"), Cells(x, 4)) > 1 Or Cell.Value = "" Then
        MsgBox (Cells(x, 4))
        Range(Cells(Cell.Row, 1), Cells(Cell.Row, 5)).Copy Destination:=Cells(destrow, 10)
        destrow = destrow + 1
    End If
    x = x + 1
Next Cell

End Sub

 

[BIGTONE559]

Thanks JackDanIce worked perfectly.