function that erase itself after work. vba - excel

i want to write something like this:
Public Function functionThatEraseHerself()
functionThatEraseHerself = "here is some work"
'ActiveCell.value = ActiveCell.value
End Function
how it now
how it must to be

It is generally not possible to change cell values from a user defined function called by a formula.
Nevertheless there is a nasty workaround using Evaluate
Option Explicit
'=functionThatEraseHerself()
Public Function functionThatEraseHerself()
Dim ReturnValue As String
ReturnValue = "here is some work"
' write the value to the cell that called this function
Application.Caller.Parent.Evaluate "ReplaceWithValue(" & Application.Caller.Address & ", """ & ReturnValue & """)"
End Function
' helper procedure that is called by evaluate
Public Sub ReplaceWithValue(ByVal Cell As Range, ByVal Value As Variant)
Cell.Value2 = Value
End Sub

Related

VBA Evaluate Excel Function

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

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.

Run time error '1004' Application defined or object defined error on Vlookup function

I am trying to utilize Vlookup function, according to the Textbox1 value user put in in Userform Guntest, automatically looking for corresponding features of the gun.
However the program currently doesn't run as it reminds me
'Runtime error '1004', method 'Range of object' _Global' failed.
The error appears on Retrieve1=…
I will be appreciated if you could help me to check where the problem is as I have really limited knowledge and experience on using VBA.
Thanks in advance.
It looks like some objects is undefined but I can't figure out where.
The module 1 code is:
Public Guncode As String
Option Explicit
Sub Test()
Call Vlookup
End Sub
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With Sheets(1)
FinalRow = Range("A65536").End(xlUp).Row
FinalColumn = Range("IV1").End(xlToLeft).Column
WholeRange = "A2:" & CStr(FinalColumn) & CStr(FinalRow)
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
The userform code is:
Option Explicit
Private Sub Label1_Click()
End Sub
Private Sub CommandButton1_Click()
If TextBox1 = "" Then Exit Sub 'Set condition 1 of exiting the program
Guncode = GunTest.TextBox1
With Me
Call Module1.Test
End With
End Sub
Private Sub PartID_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub
It should run properly but it doesn't. Any help would be appreciated, thanks!
First off, you were passing in a number as the column letter value. CSTR() doesnt magically transform it into the letter equivalent but I like your enthusiasm.
Second, your method will bomb if the value isnt found - so you'll need to write your own error handling for it.
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
Dim vArr
Dim col_Letter As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With ThisWorkbook.Sheets("Sheet1")
FinalRow = .Range("A65536").End(xlUp).Row
FinalColumn = .Range("IV1").End(xlToLeft).Column
vArr = Split(Cells(1, FinalColumn).Address(True, False), "$")
col_Letter = vArr(0)
WholeRange = "A2:" & col_Letter & CStr(FinalRow) '<---- you were passing a number in as the column value
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
1. I am not sure what is the reason using Address(True, False) for row number.
This comes from a combination of these two functions. The true/false setting is telling the funciton to use/not use absolute references in the address.
Split ( expression [,delimiter] [,limit] [,compare] )
https://www.techonthenet.com/excel/formulas/split.php
expression.Address (RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
https://learn.microsoft.com/en-us/office/vba/api/excel.range.address
Shouldn't Cell (1, FinalColumn) stands for the column number?
No, the cells fucntiosn basically returns an intersection/address of rows & column.
Try this for example: debug.Print; thisworkbook.Sheets("Sheet1").Cells(2,2)
You mentioned CSTR doesn't magically transform to letter equivalent so what would it transform to? Could you further elaborate?
This is a data type conversion function. CSTR(666) essentially does this: this 666 becomes this "666"
2. vArr(0). I am confused with what does the parameter 0 stands for in the bracket. Actually this is a general question I always have regarding to parameter specification.
This is an array position refence. The split function returns an array of strings. Since we're using to capture the column label value, we only need to reference the first position.
(3) I tried copy your code and run it but still reminds me error on the same row.
Works fine for me unless there is no returning value, which returns an error which is what I meant by "bomb."

Set VBA Variable to Result from Function which is String

I've read a bunch about functions today and they all seem to deal with math/numbers. I'm trying to use a function which returns a string and capture that as a variable in the "main sub" but I can't get it to work. Can anybody point out what I'm doing wrong?
Eg:
Function:
Public Function Test(var) As Variant
Bar = var & "World"
MsgBox Bar
End Function
Sub:
Public Bar As Variant
Public Z As Variant
Sub testing()
Call Test("Hello") ' This displays "HelloWorld" from MsgBox in Function
Test ("Hello") ' This displays "HelloWorld" from MsgBox in Function
Z = Test("Hello") ' This displays "HelloWorld" from MsgBox in Function
MsgBox Z ' This displays an empty MsgBox :*(
End Sub
If you want the function to return a value, populate the function variable and return that in the main sub, like so
Public Function Test(var As String) As String
Test = var & " World"
End Function
Sub testing()
returnstr = Test("Hello")
MsgBox returnstr
End Sub
You aren't returning a value from the function. Also, functions should only be used to return values, not to perform actions that change things (other than variables) or display pop-ups. It also gets confusing having global variables and passing variables to a function. You generally pass local variables to a function. Here's a cleaner example (with your main function first, as is normal convention):
Sub Testing()
Dim Z As String
Z = Test("Hello")
MsgBox Z
MsgBox Test("Hello")
End Sub
Public Function Test(ByRef var As String) As String
Test = var & "World"
End Function

Excel VBA function can't set range

I've written a VBA function that takes two parameters, the first is a string and the 2nd is a range, specified in the sheet as:
=strPack(B1,G3)
In the code, this routine is declared as:
Public Function strPack(ByVal strHex As String, ByRef rngCnt As Range) As String
On Error Goto ErrHandler
If False Then
ErrHandler:
MsgBox Err.Description
Exit Function
End If
Dim intCnt As Integer
intCnt = 0
'...do something with strHex and increment intCnt whilst we go
rngCnt.Value = CStr(intCnt)
'strPack is populated by the body of the function
strPack = "Hello World"
End Function
I've tried .Value, .Value2 and .Text, all result in an error:
Application-defined or object-defined error
When I look in the debugger, both strHex and rngCnt are valid and correct. Why can't I assign to the range and how do I fix it?
The error handler is not the problem, try it out, it works perfectly well and is a standard way of picking up errors and aborting a function when an error occurs.
[Edit] I've just tried the following:
Public Sub updateCount()
Worksheets("Sheet1").Range("G3").Value = CStr(intProcessed)
End Sub
intProcessed is global to the module and is an integer, result is the same, exactly the same error.
[Edit2] I want to remove this post as I've changed the approach now to call another subroutine that returns a value which is dropped into the cell. I can't delete it! Thank you to all for your help.
See the code comments:
Public Function strPack(ByVal strHex As String, ByVal rngCnt As Range) As String
Dim lRes As Long
On Error GoTo errHandler
lRes = 1000 '==> Your business logic goes here
'/ This is the gymnastics you do to update range from an UDF
Application.Evaluate ("UpdateRange(" & rngCnt.Address & "," & lRes & ")")
strPack = "SUCCESSFULL"
errHandler:
If Err.Number <> 0 Then
strPack = "FAILED"
End If
End Function
'/ Helper to allow range update from UDF
Private Function UpdateRange(rngDest As Range, val As Variant)
rngDest.Value = val
End Function

Resources