Is this what you want?

Sub DeletingStuffInA()
Dim i As Integer, X As Integer
i = 1: X = 0
Do Until X = 25
If Cells(i, 1) < "" Then
Cells(i, 5) = "Total Transactions"
Cells(i, 1).EntireRow.Insert
i = i + 2
Else
X = X + 1
i = i + 1
End If
Loop
End Sub

Regards,
Greg


-----Original Message-----
Hello there,

I modified some code so that it will find cells in column
A that are
not blank, then add a new row above it and fill a cell
with some text.


The problem is simple

It finds a filled cell in column A inserns a new row and
some text then
looks at the next row down (the same one it say in the
first step) and
adds another row with the text and so on and so on and so
on.


I tried to add a fix I could think of but not it just
runs from the top
of the a column to the end + 25 rows.

here is the code with my current not-fix:

Sub DeletingStuffinA() ' deletes topcrop in the report
Range("A3").Select '
Do Until X = 25 'Change number for extra number of blanks
between data
CaseText = activecell.Value
Select Case (CaseText)

Case Is < ""
selection.EntireRow.Insert
activecell.Offset(-1, 4) = "TOTAL TRANSACTIONS"
activecell.Offset(2, -4).Select
Y = 1

End Select
If Y = 1 Then
Else
activecell.Offset(1, 0).Select
End If
If activecell = "" Then
X = X + 1
Else
X = 0
End If
Y = 0
Loop
End Sub


---
Message posted from http://www.ExcelForum.com/

.