I'm programming a Macro in VB for Excel 2013 that search for coincidences in different worksheets, and add a link to the cells that match.
I'm havin torubles to insert the link in the cell, since the link must be different for a range of cells, I need help here.
Here is my code
Dim bufferDetails As String
Dim tmpCell As String
Dim spot As String
Dim cell As Variant
Dim cellSpots As Variant
For Each cell In Worksheets("MMS-Locations").Range("D2:D1833")
If (cell.Value2 = "NULL") Then
cell.Value2 = "NULL"
Else
tmpCell = cell.Text
'A62
If (Left(tmpCell, 3) = "A62") Then
spot = spotName(tmpCell)
For Each cellSpots In Worksheets("DetailedMap").Range("G60:CF123")
If (cellSpots.Value2 = spot) Then
For Each linkToSpot In Worksheets("MMS-Locations").Range("H2:H1833")
Worksheets("MMS-Locations").Hyperlinks.Add _
Anchor:=Range(linkToSpot), _
Address:="http://example.microsoft.com", _
ScreenTip:="Microsoft Web Site", _
TextToDisplay:="Microsoft"
Next linkToSpot
Debug.Print ("Encontrado " + cellSpots)
End If
Next cellSpots
End If
End If
Next cell
End Sub
Function spotName(fullName As String) As String
Dim realSpot As String
Dim lenght As Integer
lenght = Len(fullName) - 3
realSpot = Right(fullName, lenght)
spotName = realSpot
End Function
As I was thinking the linkToSpot variable contains the actual cell in the range, so I can move my selection of the sell, but my code fails in there with this error:
Error in the Range method of the '_Global' object,
Just for reference, here is what I use to convert a phone number to an email for texting..setting it as a hyperlink in the current cell.
ActiveCell.Value = myNumbr
Set myRange = ActiveCell
ActiveSheet.Hyperlinks.Add anchor:=myRange, Address:="mailto:" & myRange.Value, TextToDisplay:=myRange.Value`
Keep your code simple to start with, until you find a working script, then add other items. Make good use of the F8 key to step through your code to find out exactly where an error occurs.
Related
First post yall.
Long story short, in Excel, when I call the following function (it's in its own module) from a cell, it returns the wrong value. The function returns the correct value when calling it from a sub, as well as when I step through the code (to the end), but the moment I call it from Excel, it returns a different value. Background at the bottom.
Things I've Tried
Making it a Public Function
Giving it an argument
Changing the function and/or module name
Moving it out of a module
Restarting Excel
A bunch of random stuff
It really is just this specific function that's giving me this issue, simpler functions do what they're told. I have to assume it has something to do with the order of events Excel is doing things, or the limits of what parts of Excel a function can change.
Function ActiveDisciplineFilters()
Application.Volatile 'makes the function update automatically
Dim disccolumn As Range
Dim uniquedisc() As String
Dim uniquediscstring As String
'create a string of unique values from the Discipline column
i = 0
If Range("LayerList[Discipline]").SpecialCells(xlCellTypeVisible).Address = Range("LayerList[Discipline]").Address Then
ActiveDisciplineFilters = "None"
Exit Function
End If
For Each cell In Range("LayerList[Discipline]").SpecialCells(xlCellTypeVisible)
If InStr(1, uniquediscstring, cell.Value) = 0 Then
If i <> 0 Then
uniquediscstring = uniquediscstring & ", " & cell.Value
Else
uniquediscstring = cell.Value
i = 1
End If
End If
Next
ActiveDisciplineFilters = uniquediscstring
End Function
Background
In Excel, I have a table. I'm taking all the data in one specific column of that table and creating a string of the unique values in that range (separated by comma). That string must be placed in another cell, for reasons I don't need to get into. If a filter is applied to the column, the unique values update automatically.
What would make Excel give me the right answer when I call it from a sub, then the wrong one when I call it from a cell?
Unfortunately, none of the SpecialCells methods work in a UDF. If you need this to be run from the worksheet as a formula, then your code should look like this instead:
Function ActiveDisciplineFilters()
Application.Volatile 'makes the function update automatically
Dim disccolumn As Range
Dim uniquedisc() As String
Dim uniquediscstring As String
Dim i As Long
Dim cell As Range
Dim bHidden As Boolean
'create a string of unique values from the Discipline column
i = 0
For Each cell In Range("LayerList[Discipline]").Cells
If cell.EntireRow.Hidden = False Then
If InStr(1, uniquediscstring, cell.Value) = 0 Then
If i <> 0 Then
uniquediscstring = uniquediscstring & ", " & cell.Value
Else
uniquediscstring = cell.Value
i = 1
End If
End If
Else
bHidden = True
End If
Next
If Not bHidden Then uniquediscstring = "None"
ActiveDisciplineFilters = uniquediscstring
End Function
I'm using VBA in Excel and I'm assigning a VLOOKUP as a formula to a cell. It works fine, but I would like to use a variable that refers to the last cell that contains a value in the column.
In the example below, I would the value for $B$269 to change depending on the number of elements in the closed document.
"=VLOOKUP(B2,'Macintosh HD:Users:myself:Documents:[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!$A$1:$B$269,2,FALSE)"
I know I want to use something along the lines of:
Range("B" & Rows.Count).End(xlUp).Address
With that said, I haven't been able to figure out how to incorporate the result, which is something like $B$269 into the VLOOKUP. I know that those formulas return the correct address because I've used it in Debug.Print.
I tried to do something like this:
"=VLOOKUP(B2,'Macintosh HD:Users:myself:Documents:[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!$A$1:"&GetLastRowFunct&",2,FALSE)"
But that didn't work.
Here is my current code:
Sub GetLastRow()
Debug.Print GetLastRowFunct
End Sub
Function GetLastRowFunct() As String
Dim openNwb As Workbook
Const MasterPath = "Macintosh HD:Users:myself:Documents:"
Dim strNewFileName As String
strNewFileName = "Master_Terms_Users.xlsm"
Set openNwb = Workbooks.Open(MasterPath & strNewFileName)
Dim openNws As Worksheet
Set openNws = openNwb.Worksheets(1)
GetLastRowFunct = openNws.Range("B" & Rows.Count).End(xlUp).Address
openNwb.Close
End Function
Any recommendations would be appreciated.
I would rewrite that function to return the entire range address, including worksheet, workbook and path.
Function GetLastRowFunct() As String
Const MasterPath = "Macintosh HD:Users:myself:Documents:"
Dim openNwb As Workbook, strNewFileName As String
strNewFileName = "Master_Terms_Users.xlsm"
Set openNwb = Workbooks.Open(MasterPath & strNewFileName)
with openNwb.Worksheets(1)
GetLastRowFunct = .Range(.cells(1, 1), .cells(rows.count, "B").End(xlUp)).Address(1, 1, external:=true)
end with
openNwb.Close
End Function
The formula construction and assignment becomes simpler to deal with.
rng.formula = "=VLOOKUP(B2, " & GetLastRowFunct & ", 2, FALSE)"
tbh, I'm not sure if you have to supply your own square brackets or not on a Mac.
I have a user defined function in excel. The function contains Application.Volatile at the top and it works great.
The problem I am experiencing now is that when I have the workbook open (lets call it workbook 1) together with another workbook (call it workbook 2), every time I make a change to workbook 2, all cells in workbook 1 that call this UDF gets a #VALUE! error.
Why is this happening?
I hope I provided enough info. If not please let me know.
Thanks
David
Hi guys, thanks for the help.
Sorry about that... here is the code:
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
If ActiveWorkbook.Name <> "SALES.xlsm" Then Return
Dim receivedWs As Worksheet, reportWs As Worksheet
Dim items As Range
Set reportWs = Worksheets("Report")
Set receivedWs = Worksheets("Received")
Dim myItem As String, index As Long
myItem = valCell.Value
Set items = receivedWs.Range("A:A")
index = Application.Match(myItem, items, 0)
If IsError(index) Then
Debug.Print ("Error: " & myItem)
Debug.Print (Err.Description)
GoTo QuitIt
End If
Dim lCol As Long, Qty As Double, mySumRange As Range
Set mySumRange = receivedWs.Range(index & ":" & index)
Qty = WorksheetFunction.Sum(mySumRange)
QuitIt:
getTotalReceived = Qty
End Function
Your problem is with the use of ActiveWorkbook,ActiveWorksheet or ActiveCell or other Active_____ objects in your UDF. Notice that Application.Volitile is an application-level property. Anytime you switch sheets, books, cells, charts, etc. the corresponding "active" object changes.
As an example of proper UDF coding practice I put together this short example:
Function appCallerTest() As String
Dim callerWorkbook As Workbook
Dim callerWorksheet As Worksheet
Dim callerRange As Range
Application.Volatile True
Set callerRange = Application.Caller
Set callerWorksheet = callerRange.Worksheet
Set callerWorkbook = callerWorksheet.Parent
appCallerTest = "This formula is in cell: " & callerRange.Address(False, False) & _
" in the sheet: " & callerWorksheet.Name & _
" in the workbook: " & callerWorkbook.Name
End Function
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
Dim index, v, Qty
v = valCell.Value
'do you really need this here?
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Function
If Len(v) > 0 Then
index = Application.Match(v, _
ThisWorkbook.Sheets("Report").Range("A:A"), 0)
If Not IsError(index) Then
Qty = Application.Sum(ThisWorkbook.Sheets("Received").Rows(index))
Else
Qty = "no match"
End If
Else
Qty = ""
End If
getTotalReceived = Qty
End Function
You actually have 2 errors in your function. The first was partially addressed by Mr. Mascaro - you need to use the Range reference that was passed to the function to resolve the Workbook that it is from. You can do this by drilling down through the Parent properties.
The second issue is that you are testing to see if Application.Match returned a valid index with the IsError function. This isn't doing what you think it's doing - IsError checks to see if another cell's function returned an error, not the previous line. In fact, if Application.Match raises an error, it is in your function so you have to handle it. I believe the error you need to trap is a type mismatch (error 13).
This should resolve both issues:
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
Dim book As Workbook
Set book = valCell.Parent.Parent
If book.Name <> "SALES.xlsm" Then Exit Function
Dim receivedWs As Worksheet, reportWs As Worksheet
Dim items As Range
Set reportWs = book.Worksheets("Report")
Set receivedWs = book.Worksheets("Received")
Dim myItem As String, index As Long
myItem = valCell.Value
Set items = receivedWs.Range("A:A")
On Error Resume Next
index = Application.Match(myItem, items, 0)
If Err.Number = 13 Then GoTo QuitIt
On Error GoTo 0
Dim lCol As Long, Qty As Double, mySumRange As Range
Set mySumRange = receivedWs.Range(index & ":" & index)
Qty = WorksheetFunction.Sum(mySumRange)
QuitIt:
getTotalReceived = Qty
End Function
I have a spreadsheet that is used for tracking work orders. The first column of the sheet has numbers starting at 14-0001 and continue sequentially all the way down. The numbers were hyperlinked to the .XLS of their respective work order (ex. the cell containing 14-0001 links to Z:\WorkOrders\14-0001-Task Name\14-0001-Task Name.xls)
Problem is, My computer crashed and when Excel recovered the file all the hyperlinks changed from:
**"Z:\blah blah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**
to
**"C:\Users\blahblah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**
There are hundreds of entries so I was hoping that I could run a script to fix all of the hyperlinks.
Heres a script I found online which from what I understood is supposed to do what I want, but when I run the script from the VB window in Excel I get "Compile error: Argument not optional" and it highlights Sub CandCHyperlinx()
Code:
Option Explicit
Sub CandCHyperlinx()
Dim cel As Range
Dim rng As Range
Dim adr As String
Dim delstring As String
'string to delete: CHANGE ME! (KEEP quotes!)
delstring = "C:\Users\***\AppData\Roaming\Microsoft\Excel\"
'get all cells as range
Set rng = ActiveSheet.UsedRange
'ignore non hyperlinked cells
On Error Resume Next
'check every cell
For Each cel In rng
'skip blank cells
If cel <> "" Then
'attempt to get hyperlink address
adr = cel.Hyperlinks(1).Address
'not blank? then correct it, is blank get next
If adr <> "" Then
'delete string from address
adr = Application.WorksheetFunction.Substitute(adr, delstring)
'put new address
cel.Hyperlinks(1).Address = adr
'reset for next pass
adr = ""
End If
End If
Next cel
End Sub
Is this even the right script? What am I doing wrong?
Try this:
Sub Macro1()
Const FIND_TXT As String = "C:\" 'etc
Const NEW_TXT As String = "Z:\" 'etc
Dim rng As Range, hl As Hyperlink
For Each rng In ActiveSheet.UsedRange.Cells
If rng.Hyperlinks.Count > 0 Then
Set hl = rng.Hyperlinks(1)
Debug.Print rng.Address(), "Before", hl.TextToDisplay, hl.Address
hl.TextToDisplay = Replace(hl.TextToDisplay, FIND_TXT, NEW_TXT)
hl.Address = Replace(hl.Address, FIND_TXT, NEW_TXT)
Debug.Print rng.Address(), "After", hl.TextToDisplay, hl.Address
End If
Next rng
End Sub
I've just had the same problem, and all the macros I tried didn't work for me. This one is adapted from Tim's above and from this thread Office Techcentre thread. In my case, all my hyperlinks were in column B, between rows 3 and 400 and 'hidden' behind the filename, and I wanted to put the links back to my Dropbox folder where they belong.
Sub FixLinks3()
Dim intStart As Integer
Dim intEnd As Integer
Dim strCol As String
Dim hLink As Hyperlink
intStart = 2
intEnd = 400
strCol = "B"
For i = intStart To intEnd
For Each hLink In ActiveSheet.Hyperlinks
hLink.TextToDisplay = Replace (hLink.TextToDisplay, "AppData/Roaming/Microsoft/Excel",
"Dropbox/References")
hLink.Address = Replace(hLink.Address, "AppData/Roaming/Microsoft/Excel",
"Dropbox/References")
Next hLink
Next i
End Sub
Thanks for your help, Tim!
I'm having some trouble looping through a variant array (8204 variable type). I'm am seeking input via an input box (type 8) and would like the user to be able to ctrl+ multiple disjointed ranges and cells. The problem that I am running into is that when I try and loop through those selected ranges it only picks up the first one.
Here's a working example of the issue:
Sub myarray()
MyAnswer = Application.InputBox("Pick a description cell(s) in spreadsheet for the link" _
& vbNewLine & "(Hold Ctrl to select multiple cells)", Type:=8)
' if its type 8204
If VarType(MyAnswer) = 8204 Then
MsgBox "Length of array: " & UBound(MyAnswer)
' loop through each element in the array
For Each vvalue In MyAnswer
MsgBox vvalue
Next
End If
End Sub
in the prompt type the following or select some ranges using ctrl+:
$A$12:$A$13,$B$4:$C$4,$D$4
for some reason I can only pick up the first range $A$12:$A$13 when I would like to loop through all elements in all the ranges/cells.
Any help is much appreciated. Thanks!
Application.InputBox returns a range object, because you are not using set it uses the default property .value, which returns only the values of the first area.
Sub myarray()
Dim MyAnswer as Range
Set MyAnswer = Application.InputBox("Pick a description cell(s) in spreadsheet for the link" _
& vbNewLine & "(Hold Ctrl to select multiple cells)", Type:=8)
' if its type 8204
If not MyAnswer is nothing Then
dim cell as Range
' loop through each cell in the range
For Each cell In MyAnswer
MsgBox cell.value
Next
End If
End Sub