Speed up Code to value all sheets

[howard]

I have code below to copy and paste values. I then have one Macro combining several macro like the one below to range value the ranges on all sheets (+- 25 sheets)

It takes +-5 mins to rn and would lioke to know if the code can be amended to speed up the process

 Sub Range_ValPRofits_BRAut()

 Dim arr As Variant
    Dim n   As Variant

    Set arr = Range("NP1_BrAu, NP2_BRAUT, NP3_AUT, NP4_AUT, NP5_AUT")

   With Sheets("Br1")
                For Each n In arr
            If .Cells(5, n.Column).Value <> "Finalised" Then
                n.Offset(1).Value = n.Value
            End If
        Next n
    End With
    Application.CutCopyMode = False
Range("a1").Select


   
End Sub

 

[Alex Blakenburg]

That will help the others if they still want to have a go, I added it in for testing at my end.
Did it reduce your +5 mins enough to solve your issue ?
Given the use of non-contiguous range names I am not sure how to make it faster.

 

[howard]

Hi Alex. It certainly is faster than before

 

[Alex Blakenburg]

Thanks for letting me know. We will wait and see if one of the others has any thoughts on making it faster.

 

[howard]

Hi Holger

Have you had a chance to amend your code. I would like to compare the sped of your code to the code Alex kindly provided

 

[HaHoBe]

Hi howard,

any procedure using loops should take more time than one which only works in memory (as there will only be one time where you write data instead of the loop).

Again, there are a lot of guesses for this:

Sub Range_ValPRofits_BRAut_Guess()
  Dim rngSet        As Range
  Dim rngCell       As Range
  Dim varNames      As Variant
  Dim lngCnt        As Long
  Dim dblStart      As Double
  Dim dblEnd        As Double
  
  dblStart = Timer
  
  With Sheets("Br1")
    varNames = Split("NP1_BrAu, NP2_BRAUT, NP3_AUT, NP4_AUT, NP5_AUT", ",")
    
    For lngCnt = 0 To UBound(varNames)
      Set rngSet = Range(varNames(lngCnt)).Rows(1).SpecialCells(xlCellTypeFormulas, 7)
      If Not rngSet Is Nothing Then
        For Each rngCell In rngSet
          If Cells(5, rngCell.Column).Value <> "Finalised" Then
            rngCell.Offset(1).Value = rngCell.Value
          End If
        Next rngCell
      Else
        Debug.Print varNames(lngCnt) & " doesn't hold formulas"
      End If
    Next lngCnt
  End With
  
  Set rngSet = Nothing
  dblEnd = Timer
  Debug.Print "Loop: " & dblEnd - dblStart

End Sub

Holger

 

[howard]

Thanks Holger

Your Code works perfectly

Both your solution and Alex's solution runs much faster than my code