pincivma

Board Regular
Joined
Dec 12, 2004
Messages
199
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
 

Some videos you may like

Excel Facts

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

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,539
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Dec 12, 2004
Messages
199

ADVERTISEMENT

Thanks Fluff

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

pincivma

Board Regular
Joined
Dec 12, 2004
Messages
199
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
Joined
Jun 12, 2014
Messages
46,539
Office Version
  1. 365
Platform
  1. Windows
Glad you sorted it & thanks for the feedback
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,050
Office Version
  1. 2016
Platform
  1. Windows
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:

Watch MrExcel Video

Forum statistics

Threads
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...
Top