Script is bogging down and will not end

J

jsd219

can anyone take a look at this script and show me if there is a way to
make it run more efficient? when i run this script it boggs and
actually never ends. i end up having to break the code to stop it.

Sub addtext_main()

Dim strCellAbove As String
Dim strCurrentCell As String
Dim s As String
Dim cell As Range

nlastrow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row
- 1
myrow = Selection.Row
howmany = nlastrow - myrow

Set cell2 = Range(Selection, Selection.Offset(howmany, 0))
cell2.Select

For Each cell In Selection
If Asc(Left(cell.Text, 1)) >= 97 And Asc(Left(cell.Text, 1)) <=
122 Then
cell.Offset(-1, 0).Value = cell.Offset(-1, 0).Value & " " &
cell.Value
ActiveSheet.Rows(cell.Row).Delete
End If

Next

End Sub

God bless
jsd219
 
T

Tom Ogilvy

Maybe something like this:

Sub addtext_main()
Dim nlastrow as Long
Dim myRow as Long
Dim cell As Range
Dim col as Long

col = Activecell.Column

nlastrow = ActiveSheet.UsedRange.Rows.Count + _
ActiveSheet.UsedRange.Row - 1
myrow = Selection.Row
howmany = nlastrow - myrow

for i = nlastrow to myrow step -1

set cell = cells(i,col)
If Asc(Left(cell.Text, 1)) >= 97 And _
Asc(Left(cell.Text, 1)) <= 122 Then
cell.Offset(-1, 0).Value = cell.Offset(-1, 0).Value _
& " " & cell.Value
ActiveSheet.Rows(i).Delete
End If

Next

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top