I've seen how to edit a hyperlink - but I need to add a hyperlink when used as a custom formula.
I get a #VALUE error and I'm not sure why. Does anyone have any ideas why I get a #VALUE error when I try to use it in a sheet as =testit39()
Public Function testit39() As String
Application.Volatile
Dim rng As range, milestoneinfo As String, milestonesymbol As String
Set rng = Application.Caller
milestoneinfo = "info"
milestonesymbol = "symbol"
If rng.Hyperlinks.Count > 0 Then
rng.Hyperlinks(1).address = ""
rng.Hyperlinks(1).screentip = milestoneinfo
Else
ThisWorkbook.ActiveSheet.Hyperlinks.Add Anchor:=rng, _
address:="", _
screentip:=milestoneinfo
rng.Hyperlinks(1).screentip = milestoneinfo
End If
testit39 = milestonesymbol
End Function
I have found a way that is not complicated thanks to this wonderful tutorial..
http://optionexplicitvba.blogspot.co.uk/2011/04/rollover-b8-ov1.html
So essentially you put it in a hyperlink and you're free to do as you please..
=hyperlink(testit39(), "Wahoo it works!")
UDFs (User-defined functions) are only allowed to return a value, they may not e.g. affect other cells or do other manipulations.
When you single-step through your code, you'll see that it aborts on the ...Hyperlinks.Add-line (and returns an error value).
Following VBA Sub code snippet allows adding new Hyperlink, or editing existing in a specified sample cell "A1" (non-essential part of your code has been removed for better clarity):
Public Sub AddOrEditHyperlink(milestonesymbol As String)
Dim rng As Range, milestoneinfo As String
'test range
Set rng = Range("A1")
'sample properties
milestoneinfo = "info"
'if Hyperlink exists, display "Edited"
If rng.Hyperlinks.Count > 0 Then
rng.Hyperlinks(1).Address = ""
rng.Hyperlinks(1).ScreenTip = milestoneinfo
rng.Hyperlinks(1).TextToDisplay = "Edited Hyperlink"
Else 'if Hyperlink does not exist, add and display "New"
rng.Hyperlinks.Add _
Anchor:=rng, _
Address:="", _
ScreenTip:=milestoneinfo, _
TextToDisplay:="New Hyperlink"
End If
End Sub
You can call this Sub from the Function that you can define (UDF) corresponding to the rest of business logic of your project (which is a bit unclear articulated):
Public Function testit39() As String
Application.Volatile
Dim rng As Range, milestoneinfo As String, milestonesymbol As String
Call AddOrEditHyperlink("some Symbol")
testit39 = milestonesymbol
End Function
Hope this will help. Best regards
Related
I have a problem:
Public Sub ChangeRow(Column As String, Value As String, id As Integer)
For i = 4 To 15
For Each rw In Worksheets(i).Rows
If Worksheets(i).Range("A" & rw.row).Value = id Then
Dim row As Integer
**row = getRow(id, i)**
MsgBox (row)
If Worksheets(i).Range(Column & rw.row).Value <> Value Then
Worksheets(i).Range(Column & rw.row) = Value
End If
Exit For
End If
Next rw
Next i
End Sub
Function getRow(id As Integer, Sheet As Integer) As Integer
For Each rw In Worksheets(Sheet).Rows
If Worksheets(Sheet).Range("A" & rw.row).Value = id Then
getRow = rw.row
End If
Next rw
End Function
Change Row Works fine... its just when I add 'row = getRow(id, i)' to the mix it throws a ByRef mismatch error??
This is a great example as to why using Option Explicit is a great practice.
Add Option Explicit to the very top of your worksheet module, outside your macro.
This forces you to declare all variables used in your subs, and also can help catch typos in your variable names.
This would catch that i is not declared. What's therefore happening is VBA/Excel by default will set i to be Variant.
Then, when you hit row = getRow(id, i), you're basically passing row = getRow([integer], [Variant]). But that sub is expecting getRow([integer],[integer])...hence your Type Mismatch error.
So, as mentioned, just do Dim i as Integer at the top of the ChangeRow sub.
(or, for long run VBA use Long instead of Integer).
In the function, you need to declare "Sheet" as Worksheet object
Function getRow(id As Integer, Sheet As Worksheet) As Integer
I don't know if I explained this too well. I'm a beginner and I'm trying to get a value from a file using VLOOKUP in VBA. However, even though I can apparently work with the string itself, I cannot use it as a variable.
So, the idea is to automatically populate two text boxes when I select something in the dropdown. The dropwdown itself determines the Worksheet that has the data.
Private Sub cbProductList1_Change()
vCode1 = Application.WorksheetFunction.VLookup(cbProductList1.Value,
[Products!A:B], 2, False)
Me.tbProdCode1 = vCode1
vPrice1 = Evaluate("VLOOKUP(" & vCode1 & ", " & Me.labelCFValue & ", 2, False)")
Me.tbPrice1 = vPrice1
End Sub
If I run a MsgBox on vCode1 - it gives me the string that needs to be the first argument for VLOOKUP.
If I run a MsgBox on Me.labelCFValue it gives me CF_1!A25:B33 (without the quotes) just as I need it to do. But when I run MsgBox on vPrice1, I get an error.
Later Edit: Alternatively, if you could help me use Me.labelCFValue inside Application.WorksheetFunction.VLookup(), that could also be good.
Please help?
I was unable to test the code but believe that this should either work or help you find your way.
Option Explicit
Private Sub cbProductList1_Change()
Dim Rl As Long ' last row
Dim LookupRange As Range
Dim Sp() As String ' splitting labelCFValue
Dim vCode1 As String
Dim vPrice1 As Double
' ActiveSheet is the default, but better to declare
With ActiveSheet
Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
Set LookupRange = .Range(.Cells(1, 1), Cells(Rl, 2))
End With
vCode1 = Application.VLookup(cbProductList1.Value, LookupRange, 2, False)
Me.tbProdCode1 = vCode1
' If Me.labelCFValue is a Label, the string should be its Caption property.
' If it is a Textbox the string should be its Value or Text property.
' Either way, it is better to specify what you are addressing:-
Sp = Split(Me.labelCFValue, "!")
Set LookupRange = Worksheets(Sp(0)).Range(Sp(1))
vPrice1 = Evaluate(Application.VLookup(vCode1, LookupRange, 2, False))
Me.tbPrice1 = vPrice1
End Sub
Consider adding some precautionary code to deal with the possibility that either of the Vlookups return an error.
Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?
Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)
Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function
i'm writing a user defined function for excel in VBA.
User may pass a whole column/row into the function instead of one cell. How do you get cell that is in the same row (for column case) and in the same column (for row case), where the function is.
For example, when you are writing in Excel in cell, say, C3 the formula "=A:A*B:B" it calculates A3*B3 in fact. I want to have the same behaiviour in my UDF.
Let's assume function that returns passed argument for simplicity reasons.
This code does not work (returns #VALUE! for columns/rows/ranges):
Public Function MyTestFunction(ByVal arg1) As Variant
MyTestFunction = arg1
End Function
My option is as follows, but I am concerned about performance and the fact that user may want to pass a value to the formula instead of Range.
Public Function MyTestFunction2(ByVal arg1 As Range) As Variant
If arg1.Count = 1 Then
MyTestFunction2 = arg1.Value
Else
' Vertical range
If arg1.Columns.Count = 1 Then
MyTestFunction2 = arg1.Columns(1).Cells(Application.Caller.Row, 1).Value
Exit Function
End If
' Horizontal range
If arg1.Rows.Count = 1 Then
MyTestFunction2 = arg1.Rows(1).Cells(1, Application.Caller.Column).Value
Exit Function
End If
' Return #REF! error to user
MyTestFunction2 = CVErr(xlErrRef)
End If
End Function
How do you solve this problem?
Thanks to valuable comments code has been slightly updated and now can be used in other formulas to filter input values.
Public Function MyTestFunction2(ByVal arg1) As Variant
If Not TypeName(arg1) = "Range" Then
MyTestFunction2 = arg1
Exit Function
End If
If arg1.Count = 1 Then
MyTestFunction2 = arg1.Value
Else
' Vertical range
If arg1.Columns.Count = 1 Then
' check for range match current cell
If arg1.Cells(1, 1).Row > Application.Caller.Row Or _
arg1.Cells(1, 1).Row + arg1.Rows.Count - 1 < Application.Caller.Row Then
' Return #REF! error to user
MyTestFunction2 = CVErr(xlErrRef)
Exit Function
End If
' return value from cell matching cell with function
MyTestFunction2 = arg1.Worksheet.Columns(1).Cells(Application.Caller.Row, arg1.Column).Value
Exit Function
End If
' Horizontal range
If arg1.Rows.Count = 1 Then
' check for range match current cell
If arg1.Cells(1, 1).Column > Application.Caller.Column Or _
arg1.Cells(1, 1).Column + arg1.Columns.Count - 1 < Application.Caller.Column Then
' Return #REF! error to user
MyTestFunction2 = CVErr(xlErrRef)
Exit Function
End If
' return value from cell matching cell with function
MyTestFunction2 = arg1.Worksheet.Rows(1).Cells(arg1.Row, Application.Caller.Column).Value
Exit Function
End If
' Return #REF! error to user
MyTestFunction2 = CVErr(xlErrRef)
End If
End Function
In the first code snippet change MyTestFunction = arg1 to Set MyTestFunction = arg1. Also add a small mechanism that recognizes the TypeName() of the arg1 and make sure that the function is receiving a Range type object.
Public Function MyTestFunction(ByVal arg1) As Variant
Set MyTestFunction = arg1
End Function
example
Then, if you get to your spreadsheet and type in =MyTestFunction(A:A) on any row and you'll receive the equivalent value from the column you're passing to the function that sits on the same row.
And your second idea about getting a similar behaviour as =A:A*B:B you can achieve with
Public Function MyTestFunction2(ParamArray arr() As Variant)
MyTestFunction2 = arr(0)
End Function
example
I think you need to use Application.ThisCell property to do it. According to MSDN:
Application.ThisCell- Returns the cell in which the user-defined
function is being called from as a Range object.
Let me present how to use it on simple example.
Imagine we have data as presented below in column A:B and we want to achieve results which comes from =A*B for each row separately.
In such situation you need the function below and put it next in C column in this way: =MyTestFunction(A:A,B:B)
Function MyTestFunction(rngA As Range, rngB As Range)
Dim funRow As Long
funRow = Application.ThisCell.Row
MyTestFunction = rngA(funRow) * rngB(funRow)
End Function
Please keep in mind that Application.ThisCell will not work if you call your function from other VBA procedure.
I have a list of keywords and want to see if one cell contains any one of these words. For example if my list of keywords is (Cat, Dog, Turtle) the function would return MATCH if it was looking inside "Mr. Dogs Magic Land". I have found a good UDF online to use as the function but when I try to loop it so it tests every word on my keyword list I get #VALUE!. The first function is my loop while the second is the UDF match function found on the internet (sorry don't remember where but props to whoever made it.) I've tried variations of word match functions such as InStr to no avail.
Function StringFind(rng(), source)
For I = LBound(rng) To UBound(rng)
StringFind = MyMatch(rng(I), source)
If StringFind = "MATCH" Then Exit Function
Next I
StringFind = "NO MATCH"
End Function
Function MyMatch(FindText As String, WithinText As Variant) As String
'
Dim vntFind As Variant
Dim vntWithin As Variant
For Each vntFind In Split(UCase(FindText), " ")
If Len(Trim(vntFind)) > 0 Then
For Each vntWithin In Split(UCase(WithinText), " ")
If Len(Trim(vntWithin)) > 0 Then
If vntFind = vntWithin Then
MyMatch = "MATCH"
Exit Function
End If
End If
Next
End If
Next
MyMatch = "NO MATCH"
End Function
1) FORMULA
I would first offer the non-VBA solution to this particular problem since VBA isn't really needed. This array formula will do the same thing. Enter the array by pressing CTRL-SHIFT-ENTER, you'll see the curly braces { } appear around your formula. Then you can copy down.
'=IF(OR(ISNUMBER(SEARCH($F$1:$F$3, A1))), "Match", "No Match")
2) UDF
Using the same syntax as yours, here's how I might approach this with a UDF.
Function MySearch(MyRNG As Range, MyStr As String) As String
Dim cell As Range
For Each cell In MyRNG
If LCase(MyStr) Like LCase("*" & cell & "*") Then
MySearch = "Match"
Exit Function
End If
Next cell
MySearch = "No Match"
End Function
Plugged this in as-is in my VBE, and I couldn't even compile.
This line
StringFind = MyMatch(rng(I), source)
needs to be changed to
StringFind = MyMatch(rng(I).Value, source)
to even get it to work for me. This MAY be the cause of your problem.
EDIT
Ok, I reviewed all in more detail. It looks like this will work for you. (Sorry, I didn't mean to just do it all for you, but here it is.) It probably needs some more tweaking to make it work for your needs.
The problem was that you were looking for undefined data types (added/changed main function call to As String and As Range). While the undefined types can work, I think it was confusing in seeing why the problem was coming up. I tried to set a breakpoint in the function and never even got that far because the wrong data type was being passed. Personally, I always use Option Explicit to help prevent issues like this from arising in my own code.
The below code will now look for the value in the first argument(Search, can be a "" text/String or a single cell/Range) against all the values in the second argument (Source a Range consisting of either a single or multiple cells).
Public Function StringFind(Search As String, Source As Range)
Dim rngCell As Range
For Each rngCell In Source.Cells
StringFind = MyMatch(Search, rngCell.Value)
If StringFind = "MATCH" Then Exit Function
Next rngCell
StringFind = "NO MATCH"
End Function
Function MyMatch(FindText As String, WithinText As Variant) As String
'
Dim vntFind As Variant
For Each vntFind In Split(UCase(FindText), " ")
If Len(Trim(vntFind)) > 0 Then
If vntFind = Trim(UCase(WithinText)) Then
MyMatch = "MATCH"
Exit Function
End If
End If
Next
MyMatch = "NO MATCH"
End Function