Solved: Is it possible to enter a UDF into a cell and replace it w a native Excel formula?

[CareerChange]

Consider this simple piece of "concept" code that stops executing at the line of code that starts w ".Formula" and returns ?NAME ...


Function TestConcept(sVars As String) As String
Dim iSum As Integer

With Range("A1")
MsgBox .Formula ' shows UDF
.Formula = "=SUM(B1:B3)" ' I want to overwrite UDF w this
MsgBox .Formula ' show updated formula
TestConcept = .Formula ' just there to complete UDF
End With
End Function

I'm trying to construct a UDF that replaces the originally entered UDF w a standard Excel formula, all in a single step.

So here's the macro-level explanation...
- Enter "=TestConcept("BuilderParameters") into a given cell
- The UDF executes, and in the proposed finished code, it finds all of the cell names in a given range that match a certain criteria
- Once a match is found, construct a new formula as it iterates through the given range
- On completion, update this cell's .Formula w the "new" Formula.
- In the end, I would replace a slow-executing UDF w a native code Excel calculation.

What am I doing wrong, or better yet, is it even possible to construct a native Excel formula "builder" via a "one shot" (e.g., as soon as it executes, it replaces itself) UDF?

Thank you for considering this question.

[mdmackillop]

You could possibly do this, but this may be a better method. Pick the name from a validation list and enter the formula accordingly. This avoids possible misspelling or recall of the parameter names.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Exits
Application.EnableEvents = False
With Target
If .Interior.ColorIndex = 6 Then
Set c = Columns(8).Find(.Value)
.Validation.Delete
.Formula = "=10*" & c.Offset(, 2) & "+20*" & c.Offset(, 3)
End If
End With
Exits:
Application.EnableEvents = True
End Sub

[CareerChange]

Thanks for the quick reply, and let me elaborate on the actual problem.

A few days ago I posted a question under the title of "SUMIF...", and xld was kind enough to supply the exact UDF that I needed to solve my problem.

The *unintended* consequence of using that UDF 100+ times on my worksheet was horrible performance due to Excel event processing kicking in that executed the those 100+ UDF 100's if not 1000+ times depending on what the user attempted to do on the worksheet. For example, my batch analytics macro that populates that particular sheet based on 10,000 + rows of raw data input data on a separate worksheet in this workbook used to take 40 seconds... w 100+ UDF's in place, it took 98 minutes... clicking on an Outline "+/-" icon resulted in a 5+ minute wait. Clearly unacceptable.

So while I need the functionality of that original UDF that dynamically summarizes cells based on "Like" parameter matching (e.g., "*gbw*M*"), I cannot live w the horrible performance that it renders on my particular application. Additionally, I should also tell you that there are 2000+ non-adjacent cell names on this particular sheet that this UDF dynamically summarizes based on said parameter matching, so the resulting calculation is not trivial.

Therefore, I need to situationally locate all of those cells (it could be anywhere between 8 - 120 cells for a given sub-category summary) and construct a native Excel formula and replace the UDF all in a single step.

Hopefully this explanation clears up why I'm trying to do this in a single step as my concept code originally intended. Can this be done, or does this violate Excel in some way?

Thank you.

[CareerChange]

As a follow-up, here's xld's original code that I modified to batch change each of those 100+ UDF's that I originally embedded into my worksheet that killed the performance.

Sub BuildFormulaDriver()
Dim sLikeArgs As String, iFirstQuote As Integer, iLastQuote As Integer, oCell As Range
With Application
.EnableEvents = False
For Each oCell In Worksheets("Forecast Projections").Range("CB136:CD136")
iFirstQuote = (InStr(1, oCell.Formula, Chr(34))) + 1
iLastQuote = Len(oCell.Formula) - 1
sLikeArgs = Mid(oCell.Formula, iFirstQuote, iLastQuote - iFirstQuote)
Call BuildFormulaForNamedCells("BN104:BY123", sLikeArgs, oCell, conIntRefersToLocal)
oCell.Formula = spubFormula
Next
.EnableEvents = True
.StatusBar = "Formula replacement complete"
End With
End Sub

Sub BuildFormulaForNamedCells(sRange As String, _
SubCat As String, _
oTarget As Range, _
iFormulaGenerationType)

Dim nme As Name, _
dSumNamedCells As Double, _
i1stSign, i2ndSign, iLen As Integer

spubFormula = "="
On Error Resume Next

For Each nme In ActiveWorkbook.Names
If Not Intersect(nme.RefersToRange, Range(sRange)) Is Nothing Then
If (nme.Name Like SubCat) And (InStr(nme.RefersTo, "#REF") = 0) Then
Select Case iFormulaGenerationType
Case conIntRefersToRange
spubFormula = spubFormula & IIf(spubFormula = "=", nme.RefersToRange, "+" & nme.RefersToRange)
Case conIntNameLocal
spubFormula = spubFormula & IIf(spubFormula = "=", nme.NameLocal, "+" & nme.NameLocal)
Case conIntRefersToLocal
i1stSign = (InStr(1, nme.RefersToLocal, "$")) + 1
i2ndSign = (InStr(i1stSign, nme.RefersToLocal, "$")) + 1
iLen = Len(nme.RefersToLocal)
sCol = Mid(nme.RefersToLocal, i1stSign, ((i2ndSign - 1) - i1stSign))
sRow = Mid(nme.RefersToLocal, i2ndSign, iLen - (i2ndSign - 1))
sShortCell = sCol & sRow
spubFormula = spubFormula & IIf(spubFormula = "=", sShortCell, "+" & sShortCell)
' dSumNamedCells = dSumNamedCells + nme.RefersToRange.Value
End Select
End If
End If
Next nme
End Sub

So I know that I can do what I want in two-steps, however I'd really like to do this in a single-step.

Thank you for considering this problem.

[CareerChange]

mdmckillop...

I got myself wrapped around the proverbial axle and concentrated more on your specific validation technique not being what I wanted rather than the bigger picture of simply trapping the request and handling it appropriately through the Worksheet_Change()... :banghead:

So here's the prototype solution framework based on your original code

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count > 1 Then Exit Sub
On Error GoTo Exits

Application.EnableEvents = False
If Left(.Value, 2) = "[" & Chr(34) Then ' trap to kick off my builder
.Formula = "=SUM(B1:B6)"
'
' insert the real code here rather than the above prototype stmt
'
End If
End With
Exits:
Application.EnableEvents = True
End Sub

Thanks again!!