Better way to write this macro.

[Risk]

I’ve got this macro which does what I need it to do but when used for a file with over 10,000 or so “ =HP “ (macro search criteria), it freezes up computers and takes a very long time to process. I took off screen updating to watch it run and at first it was going quickly cell by cell, then its performance worsened and it went very slowly cell by cell so that to complete 12 cells it would take about 20 seconds.

Does anyone know a way to write this formula in a more efficient manor?

Sub ValueHPAll()
TxtMsg = "You have selected to value all Hyperion formula's in this workbook. If you wish to proceed please select OK"
y = MsgBox(TxtMsg, vbOKCancel, "Proceeding with valuing Hyperion formula's.")

Application.ScreenUpdating = False 'turn off screen updating

If y = 1 Then
    
    Dim sh As Worksheet, HidShts As New Collection
    For Each sh In ActiveWorkbook.Worksheets
        If Not sh.Visible Then
            HidShts.Add sh
            sh.Visible = xlSheetVisible
        End If
    Next sh
                
        For Each x In Worksheets
            Sheets(x.Name).Activate
            Range("a1").Select
            ActiveCell.SpecialCells(xlLastCell).Select
            LastCell = ActiveCell.Address
            Range("a1:" & LastCell).Select
            
            For Each z In Selection
                If InStr(1, z.FormulaR1C1, "HPLNK") = 0 Then
                    If InStr(1, z.FormulaR1C1, "HP") > 0 Or InStr(1, z.FormulaR1C1, "hp") > 0 Then
                        If z.HasFormula Then
                           z.Copy
                           z.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                           :=False, Transpose:=False
                        End If
                    End If
                End If
            Next z
            Range("a1").Select
        Next x
    Application.ScreenUpdating = True 'refresh the screen
    
For Each sh In HidShts
        sh.Visible = xlSheetHidden
    Next sh

Else
MsgBox "You have chosen to cancel this process"

End If

End Sub

I have some other valuing macro's which run at speeds which could probably only be measured in nano seconds, but it doesn't look cell by cell

Sub ValueAll()
TxtMsg = "You have selected to value all formula's in this workbook. If you wish to proceed please select OK"
y = MsgBox(TxtMsg, vbOKCancel, "Proceeding with valuing all formula's.")

Application.ScreenUpdating = False 'turn off screen updating

If y = 1 Then
     
    Dim sh As Worksheet, HidShts As New Collection
    For Each sh In ActiveWorkbook.Worksheets
        If Not sh.Visible Then
            HidShts.Add sh
            sh.Visible = xlSheetVisible
        End If
    Next sh
     
    Worksheets.Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Select
    Application.CutCopyMode = False
     
    For Each sh In HidShts
        sh.Visible = xlSheetHidden
    Next sh
     
    Application.ScreenUpdating = True 'refresh the screen
    
Else
MsgBox "You have chosen to cancel this process"

End If

End Sub

Is their a way to rewrite the first marco to make it run as fast as the second?

 

[Risk]

bump

 

[jimrward]

since your operations do not seem to be calculation based you could turn off calculations before your loop

Application.Calculation = xlManual

and after the loop turn it back on

Application.Calculation = xlAutomatic

 

[dcardno]

Try

Sub ValueHP2()

Dim sh         As Worksheet
Dim HidShts    As New Collection
Dim y          As Integer
Dim cllForm    As Range
Dim TxtMsg     As String
' all declarations are explicit and typed

TxtMsg = "You have selected to value all Hyperion formula's in this workbook." & Chr(10)
TxtMsg = TxtMsg & "If you wish to proceed please select OK" & Chr(10)
TxtMsg = TxtMsg & "This will replace all Hyperion formulas with their current values"
y = MsgBox(TxtMsg, vbOKCancel, "Proceeding with valuing Hyperion formula's.")

Application.ScreenUpdating = False          'turn off screen updating

If y = 1 Then

    For Each sh In Worksheets
        If Not sh.Visible Then
            HidShts.Add sh
            sh.Visible = xlSheetVisible
        End If
    Next sh

    For Each sh In Worksheets
        ' no need to activate / select worksheets in sequence
        ' no need to define / select used range in worksheets
        For Each cllForm In sh.UsedRange
            If cllForm.HasFormula Then
             ' test for formula / label first
                If InStr(1, cllForm.Formula, "HPLNK") = 0 Then
                    If InStr(1, UCase(cllForm.Formula), "HP") > 0 Then
                     ' trade UCase for OR         
                cllForm.Value = cllForm
                     ' I think that this will be faster than Copy / Paste Special
                    End If
                End If
            End If
        Next cllForm
    Next sh

    For Each sh In HidShts
        sh.Visible = xlSheetHidden
    Next sh
    Application.ScreenUpdating = True       'refresh the screen
Else
    MsgBox "You have chosen to cancel this process"

End If

End Sub

I would be curious to know if this is any faster.

 

[HalfAce]

Hello Risk,
I started going through your code and got hung up with work before finishing and it looks
like dcardno came up with pretty much the same idea, but here it is anyway.

Option Compare Text

Sub ValueHPAll()
TxtMsg = "You have selected to value all Hyperion formula's in this workbook. If you wish to proceed please select OK"
y = MsgBox(TxtMsg, vbOKCancel, "Proceeding with valuing Hyperion formula's.")

If y = 1 Then
  Application.ScreenUpdating = False
  Dim sh As Worksheet, HidShts As New Collection, z As Range
  For Each sh In ActiveWorkbook.Worksheets
    If Not sh.Visible Then
      HidShts.Add sh
      sh.Visible = xlSheetVisible
    End If
    With sh
      For Each z In .UsedRange
        If InStr(1, z.FormulaR1C1, "HPLNK") = 0 Then
          If InStr(1, z.FormulaR1C1, "HP") > 0 Then
            If z.HasFormula Then z.Value = z.Value
          End If
        End If
      Next z
    End With
  Next sh
  For Each sh In HidShts
    sh.Visible = xlSheetHidden
  Next sh
Else
  MsgBox "You have chosen to cancel this process"
End If
Application.ScreenUpdating = True
End Sub

If you're really interested in seeing how much (if any) quicker either of these are than
your original code you can always use the Timer to see exactly how long each one
takes to execute.

(I too would be curious...)

 

[dcardno]

Risk - I hadn't thought about setting "Option Compare Text" as done by HalfAce, but it is agood suggestion; that would simplify the test for the string HP in the cell formula. Compare his test (If InStr(1, z.FormulaR1C1, "HP") > 0) to mine (If InStr(1, UCase(cllForm.Formula), "HP") > 0): by setting the comparison to "Text" you can avoid the explicit conversion of the formula to all upper case. You are instead relying on the implicit conversion due to the comparison setting, which I suspect will be faster.