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.
Related
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
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
Excel VB newbie. I know I must be missing something very simple. How do I get before_save event to work with more than one worksheet? Only one needs code. I have it in ThisWorkbook. It works if I only have one sheet in my workbook.
After seeing the comment that it doesn't matter if there's more than one worksheet I looked again at my code. I fixed the code and now the BeforeSave event will trigger and not save until all conditions are met like it's supposed to.
The BeforeSave event triggers if I put it in ThisWorkbook. But if I put it in Sheet1 and call the sub in ThisWorkbook, it still runs the sub like it's supposed to but doesn't prevent it from saving. Hoping this makes sense. I know the code is messy so please bear with me.
Sheet1:
Sub checkSheet1()
Dim cellCount As Variant, findEmpty As String, Counter%
allYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"), Range("C62"))
noDateYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"))
emptyCell = ""
Counter = 0
Debug.Print vbNewLine & "List the values of each cell in the array:"
'count number of yellow/empty cells
For Each cellCount In allYellowCellsArray
Debug.Print cellCount.Address() & " value is " & cellCount & " and color is " & cellCount.DisplayFormat.Interior.Color
If cellCount = emptyCell Then
Counter = Counter + 1
End If
Next
'If-Then statements to alert how many yellow cells are still empty.
If Counter >= 1 Then
MsgBox "(" & Counter & ") Mandatory Cells Have Not Been Completed", vbExclamation, "Missing Information"
'cellCount = "Enter Missing Information"
End If
For Each cellCount In noDateYellowCellsArray
If cellCount.Value = "" Then
cellCount.Value = "Enter Missing Information"
End If
Next
'Evaluate all yellow cells to prevent empty cells and make sure the set values have been changed ----
Dim cellValue As Variant
Dim fieldsAreYellow As Boolean
fieldsAreYellow = True
Dim redCellColor As Boolean
redCellColor = True
Dim cellCellColor As Variant
Debug.Print vbNewLine & "List cells that are red:"
For Each cellCellColor In allYellowCellsArray 'check for red cells
If cellCellColor.DisplayFormat.Interior.Color = 255 Then 'if cell background color is red
redCellColor = True
Debug.Print cellCellColor.Address() & " is " & cellCellColor.DisplayFormat.Interior.Color
Cancel = True
End If
If redCellColor = False Then
MsgBox "There are no more red cells."
Cancel = True
End If
Next cellCellColor
Dim cellCountRedCells As Variant, redCellCounter%
redCellCounter = 0
For Each cellCountRedCells In allYellowCellsArray
If cellCountRedCells.DisplayFormat.Interior.Color = 255 Then 'red
redCellCounter = redCellCounter + 1
Debug.Print "redCellCounter is " & redCellCounter
'MsgBox "redCellCounter is " & redCellCounter
End If
Next
Debug.Print "redCellCounter is " & redCellCounter
'Check to see if cells in array have been changed
Debug.Print vbNewLine & "List the current background color of the first non-numeric cell that stopped the loop:"
For Each cellValue In allYellowCellsArray
If cellValue = "Enter Missing Information" Then
Debug.Print vbNewLine & cellValue
fieldsAreYellow = False
Debug.Print cellValue.Address() & " color is " & cellValue.DisplayFormat.Interior.Color
MsgBox "Check all of your cells for correct information." & vbNewLine & "There are still (" & redCellCounter & ") red cells.", vbCritical, "SAVE CANCELLED"
Cancel = True ' ** prevent the file from being saved **
Exit For
End If
Next cellValue
'Final check
If (fieldsAreYellow = True) And (redCellCounter = 0) Then
MsgBox "The document will be saved." & vbNewLine & "Remember the naming convention." & vbNewLine & "Customer_PIP Seal Calculator_Part Number rev#_Part Name_DDMMYY", vbInformation, "Good to Go!"
Cancel = False 'allow save
Else:
MsgBox "This file will not save until all of the cells have correct information.", vbCritical, "SAVE CANCELLED"
Cancel = True 'cancel save
End If
End Sub
ThisWorkbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Sheet1.checkSheet1
End Sub
I created a new excel file and tested this event. It works perfectly on both sheets.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "OK"
End Sub
I suggest to try this on a new file and then copy your code to the new file.
In order to make the event was as you need, the called Sub must be transformed in a Function returning Boolean.
The event code should look like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Sheet1.checkSheet1
End Sub
And the called function, like this:
Public Function checkSheet1() As Boolean
If 1 = 1 Then
MsgBox "The saving cannot take place..."
checkSheet1 = True 'instead of Cancel = True in the Sub
Else
checkSheet1 = False
End If
End Function
You must adapt your code to finally return something like checkSheet1 = Cancel. But take care to properly declare Dim Cancel as Boolean...
If something unclear, please, do not hesitate to ask for clarifications. If you need me to transform your existing Sub, I can do it, but I think it is better for you do do that, in order to understand the meaning and learn...
Loop Through Worksheets In BeforeSave
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Create a list of worksheet names.
Const wsList As String = "Sheet1,Sheet2,Sheet3"
Dim nms() As String ' Declare an array of type 'String'.
nms = Split(wsList, ",") ' Write the list to the array.
Dim ws As Worksheet ' Declare a worksheet variable.
Dim n As Long ' Declare a 'counter' variable of type 'Long'.
' Loop through the elements (names) in the array.
For n = 0 To UBound(nms)
' Define current worksheet.
Set ws = ThisWorkbook.Worksheets(nms(n))
' Do something, e.g. write some text to cell 'A1' and autofit column 'A'.
ws.Range("A1").Value = "Testing worksheet '" & ws.Name & "'."
ws.Columns("A").AutoFit
Next n
End Sub
I would like to loop through 4 certain worksheets in a workbook.
Bulk of the code I am running is the same in each sheet.
I am also opening and linking different cells from other workbooks and these will be different on each sheet, hence why my code will be slightly different as it will change variables.
The problem I have is It's working but ignores the rest of my if statements except the first so doesn't run the way I want it to. Example below
Sub CompleteSummary()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim x As Workbook
Dim sht As Worksheet
Dim Sshts As Variant
Dim Ssht As Variant
Dim i As Integer
Set x = Workbooks.Open(s, ReadOnly:=True)
If Application.Calculation = xlCalculationAutomatic Then
Else: Application.Calculation = xlCalculationAutomatic
End If
Sshts = Array("First1", "Second1", "Third1", "Fourth1")
For i = 0 To UBound(Sshts)
Set sht = x.Worksheets(Sshts(i))
Debug.Print "print me " & Sshts(i)
If sht.Name = "First1" Then
Debug.Print "opened 1st"
ElseIf sht.Name = "Second1" Then
Debug.Print "opened 2nd"
ElseIf sht.Name = "Third1" Then
Debug.Print "opened 3rd"
ElseIf sht.Name = "Fourth1" Then
Debug.Print "opened 4th"
End If
Debug.Print "Complete"
Next i
The output result is as follows:
print me First1
opened 1st
Complete
print me Second1
Complete
print me Third1
Complete
print me Fourth1
Complete
What I would like it to do is this:
print me First1
opened 1st
Complete
print me Second1
opened 2nd
Complete
print me Third1
opened 3rd
Complete
print me Fourth1
opened 4th
Complete
As you can see it just takes the first if condition throughout the loop and ignores the rest despite it cycling through all of the sheets.
Any ideas or even if there is a better way than a loop and if conditions?
I think this would be an easier approach:
Dim wb As Workbook: Set wb = ThisWorkbook
Dim x As Workbook
Dim sht As Worksheet
Set x = Workbooks.Open(s, ReadOnly:=True)
Application.Calculation = xlCalculationAutomatic 'just do it...
For Each sht In x.Worksheets
Debug.Print "Checking: " & sht.Name
Select Case sht.Name
Case "First1": Debug.Print "opened 1st"
Case "Second1": Debug.Print "opened 2nd"
Case "Third1": Debug.Print "opened 3rd"
Case "Fourth1": Debug.Print "opened 4th"
End Select
Debug.Print "Done checking"
Next sht
For extra robustness compare the lower-cased names.
By your description you don't need an Ifs or Elses. Instead just call a sub that has the repetitive code and feed it arguments that make up the difference. Here is a schematic example.
Option Explicit
Sub CompleteSummary()
' 113
Dim Wb As Workbook
Dim WsName() As String
Dim i As Integer
If Application.Calculation = xlCalculationAutomatic Then
Application.Calculation = xlCalculationManual
Else
Application.Calculation = xlCalculationAutomatic
End If
Set Wb = ThisWorkbook
WsName = Split("First1,Second1,Third1,Fourth1", ",")
For i = 0 To UBound(WsName)
If DoTheWork(WsName(i)) Then Debug.Print "Complete"
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
Private Function DoTheWork(WsName As String) As Boolean
' 113
On Error Resume Next
Debug.Print "Opened " & WsName
DoTheWork = (Err.Number = 0) ' no error occurred
Err.Clear
End Function
If there are different workbooks to be opened depending upon which worksheet is being worked on you can make this choice either in the main procedure or the sub. In the latter case you would pass 2 parameters instead of the one in my example. I think you could pass up to 255 arguments.
I developed the sub as a function which returns True or False depending upon whether the action was executed without error. You could also let the function return another value, such as the result of a calculation which is slightly different for each set of arguments and that you may use to continue whatever the Main procedure is doing.
Multiple Worksheets
I suspect what happened was that your last three worksheets had slightly different names i.e. their case was different.
The First Procedure CompleteSummary
The contents of the Sheet Names Array demonstrate the opposite of the previous case: the worksheet names are intentionally written in a different case to show that case doesn't matter when accessing a worksheet (or opening a workbook).
The use of the Opened Array allows us to avoid the If clause and therefore avoid checking the worksheet names.
With the With statements we can avoid using additional variables.
The first Debug.Print line will print the actual worksheet names and the names in the Sheet Names Array in parentheses.
The second Debug.Print line further shows how the If clause is avoided.
The Second Procedure StringCompare
When comparing strings where there might be a difference in case, you can use one of the ways presented in this procedure.
Most often I have seen the use of LCase or UCase, but I prefer StrComp whose only purpose is to compare two strings.
In your particular case, for all comparisons you could have e.g. used one of the following options:
If LCase(sht.Name) = LCase("First1") Then
If UCase(sht.Name) = UCase("First1") Then
If StrComp(sht.Name, "First1", vbTextCompare) = 0 Then
etc.
Additionally there is an option of using Option Compare Text right after Option Explicit i.e. before any procedure. Then you could safely use your solution without any changes.
The Code
Option Explicit
'Option Compare Text
Sub CompleteSummary()
Const wbPath As String = "F:\Test\2020\64688445\Test.xlsm"
Dim SheetNames As Variant
SheetNames = Array("FiRst1", "SecOnd1", "ThiRd1", "FouRth1")
Dim Opened As Variant
Opened = Array("1st", "2nd", "3nd", "4th")
Dim n As Long
With Workbooks.Open(Filename:=wbPath, ReadOnly:=True)
For n = LBound(SheetNames) To UBound(SheetNames)
With .Worksheets(SheetNames(n))
Debug.Print "print me " & .Name & " (" & SheetNames(n) & ")"
Debug.Print "opened " & Opened(n)
Debug.Print "Complete"
End With
Next n
' Since each workbook was only read from we can safely close it.
'.Close SaveChanges:=False
End With
End Sub
Sub StringCompare()
Debug.Print "Assign: ", "A" = "a"
Debug.Print "Like: ", "A" Like "a"
Debug.Print "StrComp0:", StrComp("A", "a") = 0
Debug.Print
Debug.Print "LCase: ", LCase("A") = LCase("a")
Debug.Print "UCase: ", UCase("A") = UCase("a")
Debug.Print "StrComp1:", StrComp("A", "a", vbTextCompare) = 0
Debug.Print "StrCpmvL:", StrConv("A", vbLowerCase) _
= StrConv("a", vbLowerCase)
Debug.Print "StrConvU:", StrConv("A", vbUpperCase) _
= StrConv("a", vbUpperCase)
Debug.Print
End Sub
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."