VBA Evaluate Excel Function - excel

I am trying to use "conditional" Large function in my code e.g. to use Large function for values where in the other column there is "Y".
I am using "Evaluate" function as I need only the results in the other part of the code.
However, this is not working - I understand that I need to work with Formula2 because otherwise excel will add '#' to the function and it wont work. But still I dont know how to 'repair' evaluate function.
I am using R1C1 formula because later I want to use columns in the loop.
Sub Makro()
'not working - there is '#' included
Range("G3") = "=Large(if(c[-4]:c[-4]=""Y"", c[-3]),2)"
'working
Range("G4").Formula2 = "=Large(if(c[-4]:c[-4]=""Y"", c[-3]),2)"
'not working
Range("G5") = Evaluate("=Large(if(c[-4]:c[-4]=""Y"", c[-3]),2)")
End Sub

Using Evaluate in a Function
Sub EvaluateStuffTEST()
Debug.Print EvaluateStuff("D", Sheet1) ' code name
Debug.Print EvaluateStuff("E", ThisWorkbook.Worksheets("Sheet1")) ' tab name
Debug.Print EvaluateStuff("F") ' ActiveSheet
End Sub
Function EvaluateStuff( _
ByVal ColumnString As String, _
Optional ByVal SourceWorksheet As Worksheet = Nothing) _
As Variant
If IsMissing(SourceWorksheet) Then Set SourceWorksheet = ActiveSheet
EvaluateStuff = SourceWorksheet.Evaluate( _
"=Large(if(C:C=""Y""," & ColumnString & ":" & ColumnString & "),2)")
End Function

Related

Worksheet Function "Filter" get data

I would like to get all the values of a column based on a matching value through the filter function.
So far I have a form, please just pay attention to label4(Name: LBL_CODIGO_SH), label5(Name: LBL_CODIGO_SH) and combobox(Name: ComboBox3).
My code is executed when clicking on the "Buscar" button:
Private Sub CommandButton4_Click()
Dim ws As Worksheet
Dim tabla As ListObject
Dim codigo As String
Set ws = Worksheets("Relacion")
Set tabla = ws.ListObjects("Tabla3")
codigo = Me.LBL_CODIGO_SH.Caption & "_" & Me.LBL_CODIGO_TH.Caption
Me.ComboBox3.List = WorksheetFunction.Filter( _
tabla.ListColumns(1).DataBodyRange, _
Evaluate(tabla.ListColumns(1).DataBodyRange.Value & "=" & codigo) _
)
End Sub
I run my program and it gives me error 13.
I think I'm skipping code in the "Filter" function of the spreadsheet.
I would like to get the results in a combobox and also in an array variable.
Try using the Address property of the DataBodyRange object, instead of the Value property . . .
Me.ComboBox3.List = WorksheetFunction.Filter( _
tabla.ListColumns(1).DataBodyRange, _
ws.Evaluate(tabla.ListColumns(1).DataBodyRange.Address & "=" & codigo) _
)
However, if you're filtering for a string, you'll need to wrap your criteria within quotes . . .
Me.ComboBox3.List = WorksheetFunction.Filter( _
tabla.ListColumns(1).DataBodyRange, _
ws.Evaluate(tabla.ListColumns(1).DataBodyRange.Address & "=""" & codigo & """") _
)
Note that the Address property returns the range reference as a string, which is used to build another string to form an expression. This concatenated string is passed to the Evaluate method, which evaluates the expression, and returns the array of booleans needed for the second argument of WorksheetFunction.Filter.
For additional information regarding the Address property, have a look here.

Call Function in another XLAM via Hyperlink Formula - Excel VBA

I'm trying to use this answer, but set it up where the Function is in another xlam workbook.
Example:
This works from remote workbook:
Sub Test()
FuncName = "#MyFunctionkClick()"
MyVal = "TestVal"
Range("A1").Value = MyVal
Range("A1").Formula = "=HYPERLINK(""" & FuncName & """, """ & Range("A1").Value & """)"
End Sub
Sub TestTwo()
Application.Run ("'remotewb.xlam'!MyFunctionkClick")
End Sub
Function MyFunctionkClick()
Set MyFunctionkClick = Selection 'This is required for the link to work properly
MsgBox "The clicked cell addres is " & Selection.Row
End Function
But I tried this without luck:
Sub Test()
'Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
'Application.Run ("'remotewb.xlam'!testremote")
'Application.Run ("'remotewb.xlam'!#MyFunctionkClick()")
'Application.Run ("'remotewb.xlam'!MyFunctionkClick") ' When calling from Remote WB it errored if I used ()
'Range("A1:A5").Formula = "=HYPERLINK(""#MyFunctionkClick()"", ""Run a function..."")"
' Range("A1:A5").Formula = "=HYPERLINK(""#MyFunctionkClick()"", ""Run a function..."")"
Range("A1:A5").Formula = "=HYPERLINK(""[remotewb.xlam]!MyFunctionkClick"", ""Run a function..."")"
'Range("A1").Formula = "=HYPERLINK(""Application.Run (" 'remotewb.xlam'!MyFunctionkClick")"", ""Run a function..."")"
End Sub
Please, try the next scenario:
Create a function in that the other workbook. For testing reasons, it should be good to place it in "Personal.xlsb", as I am trying it:
Function GiveMeFive(x As Long, y As Long) As Long
Debug.Print "In Personal.xlsb code: " & x + y 'not important, ONLY TO SEE IT WORKING with parameters in Immediate Window
GiveMeFive = 5 'it can be calculated, but look to the function name :)
End Function
Create the (necessary) hyperlink in the active sheet (it can be created in any sheet):
Sub TestCalFunctionHyp()
Dim FuncName As String, myVal As String
FuncName = "#MyFunctionHyp()"
myVal = "Call external Function (parameters):4|3" 'just to see how to call it with parameters
Range("A1").Value = myVal
Range("A1").Formula = "=HYPERLINK(""" & FuncName & """, """ & Range("A1").Value & """)"
End Sub
How the (directly) called (by hyperlink) function should look:
Function MyFunctionHyp()
Dim arr
Set MyFunctionHyp = Selection
arr = Split(Split(Selection.Value, ":")(1), "|")
TestTwo CLng(arr(0)), CLng(arr(1)) 'calling the sub calling the one in the other wb
End Function
The sub calling the function in the other workbook should look like:
Sub TestTwo(arg1 As Long, arg2 As Long)
Dim x As Long
x = Run("'C:\Users\YourUser\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB'!GiveMeFive", arg1, arg2)
Debug.Print "Received from called function: " & x
End Sub
The function calls the function using its full path, only due to the fact that, in case the workbook keeping the function is not open, it will open it...
Please, take care to adapt the path in order to use your real YourUser...
I would like to receive some feedback after testing it. If something not clear enough, do not hesitate to ask for clarifications.

Excel persistent evaluate if condition is met

I am trying to evaluate an expression only if a certain condition is met. The reason I am doing this is to allow the user to "lock" a value so that changes to other variables in the formula have no effect anymore.
I tried using the function below which works great until I close the sheet and open it again.
I already tried to use an additional cell passed as parameter to copy the value to it when it's not locked and copy it back if so however excel does not allow other cell modifications within a function.
Is there any way to achieve this functionality?
Function EvaluateIf(expression As String, condition As Boolean) As Variant
Application.Volatile
Dim myText As String
Dim myVal As Variant
If condition Then
myVal = Application.Evaluate(expression)
Else
myText = Application.Caller.Text
If IsNumeric(myText) Then
myVal = Val(myText)
Else
myVal = myText
End If
End If
EvaluateIf = myVal
End Function
EDIT1:
I need to apply this function onto multiple cells so I cannot hard code the cells
EDIT2:
I currently call the function like this in excel:
=EvaluateIf(N$7*IF(ISBLANK(P$7);1;P$7)*IF(ISBLANK(R$7);1;R$7);NOT(V$7))
Try this out - normal cautions apply to using this method to skirt around the restrictions applied to the use of UDF when called from a worksheet.
Function EvaluateIf(expression, condition As Boolean, backup As Range) As Variant
Dim myText As String
Dim myVal As Variant
Dim bak
bak = backup.Value
If condition Then
myVal = expression
If myVal <> bak Then 'update cached value?
Application.Evaluate "SetBackup(""" & backup.Parent.Name & """,""" & _
backup.Address & """,""" & myVal & """)"
End If
Else
myVal = bak
End If
EvaluateIf = myVal
End Function
Sub SetBackup(ws As String, addr As String, v)
Application.Calculation = xlCalculationManual 'avoid infinite loop!
ThisWorkbook.Sheets(ws).Range(addr).Value = v
Application.Calculation = xlCalculationAutomatic
End Sub

How do I join the word "Sheet" and an integer to form sheet code name

How can I concatenate the word "Sheet" with a number (say, 2) to form a string that can be used as the code name of a sheet.
I've tried the following piece of code but it doesn't seem to work.
Sh = "Sheet" & 2
Range("A1") = Sh.index
If you want to refer the sheet just based on index you could try something like this as well ... hope it works for you
Sub trial()
i = 2
Sheets(i).Select
End Sub
I assume you want to check if a given â–ºstring argument (CodeNameString) refers to a valid Code(Name) in the VBA project. *)
If so, the following function returns the worksheet to be set to memory; otherwise the second argument IsAvailable passed by reference will change to False and can be used for error checks (c.f. ExampleCall below).
Function SheetByCodename(ByVal CodeNameString As String, ByRef IsAvailable As Boolean) As Object
'check for same CodeName in Sheets collection
Dim ws As Object
For Each ws In ThisWorkbook.Sheets
If ws.CodeName = CodeNameString Then ' check for string identity
Set SheetByCodename = ws ' set sheet object to memory
IsAvailable = True ' assign true to 2nd argument passed ByRef
Exit For
End If
Next
End Function
Example call
Sub ExampleCall()
dim cnt As Long: cnt = 2 ' << change example counter
Dim okay As Boolean ' << needed variable passed as 2nd function argument
With SheetByCodename("Sheet" & cnt, okay)
If okay Then
Debug.Print _
"a) Worksheet Name: " & .Name & vbNewLine & _
"b) Sheet's Code(Name) in Project: " & .CodeName
Else
Debug.Print "Given string refers to no valid Code(Name)."
'do other stuff to handle the wrong input
End If
End With
End Sub
*) Take note of #RonRosenfeld 's important remarks in comment:
"Codename is assigned when the worksheet is created. It can be changed in the properties window. In order to change it programmatically, you need to enable Trust Access to the VBA object model. Otherwise, it's a read-only property. "

getting run time 13 error in vba how to fix this

I'm actually trying to code the sumproduct VBA script but I'm getting the runtime 13 error...
VBA:
Option Explicit
Sub sample_sumpro()
Dim cal_date, nxt_date As Date
cal_date = #12/30/2016#
nxt_date = cal_date + 1
Dim name As String, ws As Sheets
name = "Kawale, Amar"
Dim dm_daily As String
With Sheets(1)
dm_daily = Application.Evaluate("SUMPRODUCT((Columns(16)=name)*Columns(4)>=cal_date)*Columns(4)<nxt_date))")
End With
MsgBox dm_daily
End Sub
In a comment to another answer, you say that you are actually trying to do a count with two criteria (or three criteria according to the question). That is better achieved with Excel's CountIfs function, which can be coded in VBA using something like:
Option Explicit
Sub sample_sumpro()
Dim cal_date As Date, nxt_date As Date
Dim name As String
Dim dm_daily As String
cal_date = #12/30/2016#
nxt_date = cal_date + 1
name = "Kawale, Amar"
With Sheets(1)
dm_daily = Application.WorksheetFunction.CountIfs(.Columns(16), name, _
.Columns(4), ">=" & CDbl(cal_date), _
.Columns(4), "<" & CDbl(nxt_date))
End With
MsgBox dm_daily
End Sub
I didn't get exactly what you're trying to do, but if (just a guess) you're trying to evaluate the SUMPRODUCT of columns 14 and 15, you might want to try this:
Sub TestEvaluate()
Dim ws As Worksheet, x As String
Set ws = Worksheets(2)
x = Evaluate("sumproduct(" & ws.Columns(14).Address & "," & ws.Columns(15).Address & ")")
MsgBox x
End Sub

Resources