Macro to isolate a 3rd party add-in group of functions.

Risk

Board Regular
Joined
Jul 27, 2006
Messages
71
I've got this nifty macro that I use to isolate a specific 3rd party add-in group of functions so that they can be valued without other stand XL functions being valued, but I'm very new to VB and I don't know how to make a modification to it. The limitation of this function is it doing a IF left 3 spaces "=HP" then value cell, but many times I have cells which contain the "HP" functions and they are not at the beginning of the code. e.g. =IF((HPVAL(X,X,X,X,X)>1),TRUE,FALSE)

In this example, the cell would not be copy paste valued since the left three spaces are "=IF" and not "=HP". The code I presently have is at the bottom of this message

....would the proper correction be


For Each z In Selection
If CONTAINS(z.FormulaR1C1) <> "HPLNK" Then
If CONTAINS(z.FormulaR1C1) = "HP" Then




Thanks for your help,

Risk



***** ORIGINAL ******

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

If y = 1 Then

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 Left(z.FormulaR1C1, 7) <> "=HPLNK" Then
If Left(z.FormulaR1C1, 3) = "=HP" Then

z.Copy
z.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Next z
Range("a1").Select
Next x


Else
MsgBox "You have chosen to cancel this process"

End If

End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I know this might sound noob, but what does this do? I'm really trying to learn VB. Thanks,

If Instr(1, z.FormulaR1C1, "HP") > 0 Then
 
Upvote 0
The InStr function returns the position of the first occurrence of one string within another (like Excel's FIND function). If it's greater than zero the string is found.
 
Upvote 0
Try this.
Code:
Sub ValueHPAll()

    TxtMsg = "You have selected to value all Hyperion formula's in this workbook. If you wish to proceed please press OK"
    y = MsgBox(TxtMsg, vbOKCancel, "Proceeding with valuing Hyperion formula's.")
    
    If y = vbOK Then
        
        For Each x In Worksheets
            With x
                LastCell = .Cells.SpecialCells(xlLastCell).Address
                For Each z In .Range("a1:" & LastCell)
                    If InStr(UCase(z.FormulaR1C1), "HP") <> 0 Then
                        z.Value = z.Value
                    End If
                Next z
            End With
        Next x
    Else
        MsgBox "You have chosen to cancel this process"
    End If

End Sub
 
Upvote 0
OK I've learned a lot so far today, but I've got one thing that was lost with the modification. The original code exempted HPLNK from pastevalues, but the new code pastevalues everything with HP.

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

If y = 1 Then

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 Left(z.FormulaR1C1, 7) <> "=HPLNK" Then
If InStr(1, z.FormulaR1C1, "HP") > 0 Then
z.Copy
z.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Next z
Range("a1").Select
Next x


Else
MsgBox "You have chosen to cancel this process"

End If

End Sub
 
Upvote 0
Well just change the logic a bit.
Code:
For Each z In .Range("a1:" & LastCell)
     If InStr(UCase(z.FormulaR1C1), "HP") <> 0 Then
        If InStr(UCase(z.FormulaR1C1), "HPLNK") = 0 Then
           z.Value = z.Value
        End If
     End If
Next z
 
Upvote 0
Finding HP but not HPLnk within function names

Hello,

Maybe this is overkill, but using the InStr function doesn't really protect you from some function with an HP embedded within its name (eg RhPass would be processed by the examples given above).

There are very interesting pattern recognition capabilities within Excel known as Regular Expressions. To use them, you need to set a reference to Microsoft VBScript Regular Expressions x.x. Use the highest version you have available to you.

The following function defines a pattern which requires at least one non Word character in front of the match - eg = or ). It then matches HP and at least one other Word character - eg HP fails but HPTest passes. It then checks explicitly for HPLnk since you mentioned that you needed to exclude that one specifically.
Code:
Function TestFormula() As Boolean
    Dim cell As Range
    ' Create a Regular Expression object
    With CreateObject("VBScript.RegExp")
        ' Set options for Regular Expression object
        .IgnoreCase = True
        .MultiLine = False
        
        ' Pattern to test
        ' ^ - Match beginning of string
        ' .* - Match anything 0 or more times
        ' \W{1} - Match a non word character exactly once
        ' hp - Match the letters hp exactly
        ' \w+ - Match additional word characters one or more times
        .Pattern = "^.*\W{1}hp\w+"
        For Each cell In Selection.Cells
            ' Only interested in formula cells
            If cell.HasFormula Then
                ' Does Regular Expression pattern defined above match within this cells contents
                If .Test(Trim$(cell.Value)) Then
                    ' Ensure HPLnk is not being processed
                    If InStr(LCase$(Trim$(cell.Value)), "hplnk") = 0 Then
                        TestFormula = True
                    Else
                        TestFormula = False
                    End If
                Else
                    ' Formula text does not match pattern defined above
                    TestFormula = False
                End If
            Else
                ' Non formula value
                TestFormula = False
            End If
        Next cell
    End With
    Set cell = Nothing
End Function 'TestFormula
If you are very new to VBA then don't worry about it if this goes over your head. I was programming a long time before I learned how to use Regular Expressions. Good LucK!
 
Upvote 0
Yeah that was way over my head, but I've got that yearning inside to understand what it means. Could you expand upon the

"but using the InStr function doesn't really protect you from some function with an HP embedded within its name (eg RhPass would be processed by the examples given above). "

I'm not even sure what RHPass is. Wow, i can see i have a lot to learn.
 
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top