overworking code, infinite running
 

Hello there,

I modified some code so that it will find cells in column A that ar
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 the
looks at the next row down (the same one it say in the first step) an
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 to
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 Su

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

overworking code, infinite running
 

Hello
Try this

Sub DeletingStuffinA() ' deletes topcrop in the report
Range("A3").Select '
Do Until ActiveCell.Row = 25 'Change number for extra
number of blanks between data
If ActiveCell.Text < "" Then
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 4) = "TOTAL TRANSACTIONS"
ActiveCell.Offset(2, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub


THIS VERSION ONLY ADDS A BLANK ROW IF YOU NEED IT.

Sub DeletingStuffinA() ' deletes topcrop in the report
Range("A3").Select '
Do Until ActiveCell.Row = 25 'Change number for extra
number of blanks between data
If ActiveCell.Text < "" Then
If ActiveCell.Offset(-1, 0) < "" Then 'only inserts a
blank row if you need a blank row
Selection.EntireRow.Insert
ActiveCell.Offset(0, 4) = "TOTAL TRANSACTIONS"
ActiveCell.Offset(2, 0).Select
Else
ActiveCell.Offset(-1, 4) = "TOTAL TRANSACTIONS"
ActiveCell.Offset(1, 0).Select
End If
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub


James


-----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/

.

overworking code, infinite running
 

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/

.