# Do Loop running slow

#### pincivma

##### Board Regular
Hi all

I wrote this simple code but it is taking a long time to run. Is there a faster running macro?

Range("BA9").Select
Do
ActiveCell.Select
If ActiveCell.HasFormula Then
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, -48).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 48).Select
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = "."

Thanks

### Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

#### mole999

##### Moderator
you might consider testing to see if your offset already has a value
if you have formulas that are calculated after every worksheet change that will have an effect
how many rows are you working with

#### pincivma

##### Board Regular
OK. I will check things out. Thanks

#### Fluff

##### MrExcel MVP, Moderator
You can also get rid of all the selects like
Code:
``````With Range("BA9")
i = 0
Do
If .Offset(i).HasFormula Then .Offset(i, -48).Value = .Offset(i).Value
i = i + 1
Loop Until .Offset(i) = "."
End With``````

#### pincivma

##### Board Regular

Thanks Fluff

I will give your code a try and see if it speeds up my macro.

#### pincivma

##### Board Regular
Hi Fluff

I finally had a chance to try your formula and I got an error on the line Loop Until .Offset(i) = ".". I also wanted formulas to remain formulas and not change into values. So I changed your macro to the following and it worked. Plus it took about 5 seconds to run the 11,000 rows. Thanks or the code.

With Range("BA9")
i = 0
Do
If .Offset(i).HasFormula Then .Offset(i, -48).formula = .Offset(i).formula
i = i + 1
Loop Until Until ActiveCell = "."
End With

#### Fluff

##### MrExcel MVP, Moderator
Glad you sorted it & thanks for the feedback

#### footoo

##### Well-known Member
See if this is quicker :
Code:
``````Dim r As Range, rng As Range, a As Range
Set r = Range("BA9:BA" & Cells(Rows.Count, "BA").End(xlUp).Row).Find(".")(0)
On Error Resume Next
If Not r Is Nothing Then
Set rng = Range("BA9:" & r.Address).SpecialCells(xlCellTypeFormulas)
Else: Set rng = Range("BA9:BA" & Cells(Rows.Count, "BA").End(xlUp).Row).SpecialCells(xlCellTypeFormulas)
End If
On Error GoTo 0
If Not rng Is Nothing Then
For Each a In rng.Areas
a.Copy a.Offset(0, -48)
Next
End If``````

Last edited:

Replies
21
Views
185
Replies
1
Views
47
Replies
2
Views
84
Replies
30
Views
1K
Replies
7
Views
82

1,109,379
Messages
5,528,349
Members
409,817
Latest member
JiNXX9500

### This Week's Hot Topics

• Change military grades into rank
Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
• VBA COUNTIF SOLUTION
Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
• INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
• Auto-Create a monthly Sign in sheet for preschool students
The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
• VBA vlookup multiple results
Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
• Extract values for earliest/latest times
I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...