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
Related
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.
I am attempting to find if a value in a cell matches the list of values in a named range that defines the dropdown for the cell.
My problem is if the user enters an asterik in the cell, this value is not a valid dropdown value but it validates to the first item in the list. In the code below, if szCellValue = "*" then the validation does not work.
Does anyone know how to get this search to work?
Range Values
DESK
ON-SITE
N/A
Code to determine the match
Dim bError As Boolean
Dim oCell As Range
Dim oFoundCell As Range
Dim szCellValue As String
Dim szLookupValue As String
szCellValue = CStr(Trim(oCell.Value2))
' Validate In Dropdown if Length > 0
If Len(szCellValue) > 0 Then
' See if the oCell value in the oRange loop exists in this szValidationNamedRange dropdown
Set oFoundCell = GetRangeFromNamedRange(cValidateCellData.ValidationNamedRange).Find(szCellValue, LookIn:=xlValues, Lookat:=xlWhole)
' If Value Not Found in Dropdown...or if they've typed in an id value (which will be found on odd numbered columns)
If oFoundCell Is Nothing Then
Call SetError(oCell.Text, cValidateCellData, "Not a Valid Value for drop down " + cValidateCellData.ValidationNamedRange + ".")
bError = True
End If
Else
If cValidateCellData.Required Then
Call SetError(oCell.Text, cValidateCellData, "Please input a value. This is a Required Field.")
End If
End If
You can use ~ to escape the asterisk.
Eg:
Dim bError As Boolean
Dim oCell As Range
Dim oFoundCell As Range
Dim szCellValue As String
Dim szLookupValue As String
szCellValue = CStr(Trim(oCell.Value2))
' Validate In Dropdown if Length > 0
If Len(szCellValue) > 0 Then
' See if the oCell value in the oRange loop exists in this szValidationNamedRange dropdown
' (escape * using ~)
Set oFoundCell = GetRangeFromNamedRange(cValidateCellData.ValidationNamedRange) _
.Find(Replace(szCellValue, "*", "~*"), LookIn:=xlValues, Lookat:=xlWhole)
' If Value Not Found in Dropdown...or if they've typed in an id value
' (which will be found on odd numbered columns)
If oFoundCell Is Nothing Then
Call SetError(oCell.Text, cValidateCellData, _
"Not a Valid Value for drop down " & cValidateCellData.ValidationNamedRange & ".")
bError = True
End If
Else
If cValidateCellData.Required Then
Call SetError(oCell.Text, cValidateCellData, _
"Please input a value. This is a Required Field.")
End If
End If
I am trying to do a loop function in VBA to select every item in the data validation (22 items) and Copy and Paste on newsheets based on the item name.
I tried Record Macro to see the language from selecting different data validation items but nothing is registering. Is there a way to manipulate each item in Data Validation in VBA?
There are 2 forms of DV. One that uses a list of cells like:
and the other that uses an internal comma separated list like:
This code will handle either form:
Sub IsDV()
Dim s As String, r As Range, rng As Range
s = "NO DV"
On Error Resume Next
With ActiveCell
s = .Validation.Formula1
On Error GoTo 0
End With
If s = "NO DV" Then
MsgBox s
Exit Sub
End If
If Left(s, 1) = "=" Then
Set rng = Range(Mid(s, 2))
For Each r In rng
MsgBox r.Value
Next r
Exit Sub
End If
ary = Split(s, ",")
For Each a In ary
MsgBox a
Next a
End Sub
EDIT#1:
As the picture shows, Formula1 creates a string. If that string begins with an = sign, then the rest of the string is an Address. So I discard the = sign and make a range. Knowing the range allows me to grab the items
I am tasked with pulling two specific rows of data from monthly sheets in a workbook.
Current code, using MyVal and a search box, is only compatible with one search. How can I change the code & searchbox function to be compatible with multiple searches?
Current code looks like this:
Sub Set_Hyper()
' Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
' {i} will act as our counter
Dim i As Long
' Use an input box to type in the search criteria
Dim MyVal As String
MyVal = InputBox("What are you searching for", "Search-Box", "")
' if we don't have anything entered, then exit the procedure
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Add a heading to the sheet with the specified search value
With Cells(1, 1)
.Value = "Found " & MyVal & " in the Link below:"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
i = 2
' Begin looping:
' We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "Data" Then
' We are checking all cells, we don't need the SpecialCells method
' the Find method is fast enough
With wks.Range("A:A")
' Using the find method is faster:
' Here we are checking column "A" that only have {myVal} explicitly
Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)
' If something is found, then we keep going
If Not rCell Is Nothing Then
' Store the first address
fFirst = rCell.Address
Do
' Link to each cell with an occurence of {MyVal}
rCell.Hyperlinks.Add Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 2)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
' Explicitly clear memory
Set rCell = Nothing
' If no matches were found, let the user know
If i = 2 Then
MsgBox "The value {" & MyVal & "} was not found on any sheet", 64, "No Matches"
Cells(1, 1).Value = ""
End If
' Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I'm thinking what you could do is create a UserForm with the following controls:
A text box
A Listbox
A button to add text to the listbox
Another button to run the VBA
The Textbox can hold the search string(s). You can make an event when you click the button to do the following:
1) Add the text from textbox to the listbox. Lookup the AddItem method to do this.
2) Clear the text box contents, so a new value can be added.
Once that's added you can add another for loop around your code to go through each item added to the listbox. That way you can do multiple searches based on what was added.
Hopefully this helps :)
I have shapes in a diagram that represent processes in a data flow; the shapes are hyperlinked to process definitions located in another tab based on the text in the shape and shape name (e.g. shape named "Control ##" with text "ABC" links to a tab where ABC process is defined). Is there a way to automatcially update the hyperlink in that shape if I change the text in the shape to be "XYZ" - i.e. I want the hyperlink to then go to the "XYZ" definition? I tried SheetFollowHyperlink event procedure but nothing seems to happen. Code i have so far is below:
Sub AssignHyperlink()
Dim CallerShapeName As String
CallerShapeName = Application.Caller
With ActiveSheet
Dim CallerShape As Shape
Set CallerShape = .Shapes(CallerShapeName)
Dim RowVar As Integer
Err.Number = 0
On Error Resume Next
If InStr(CallerShapeName, "Control") = 1 Then
RowVar = Application.WorksheetFunction _
.Match(.Range("C2").Value & CallerShape.TextFrame2.TextRange.Text, _
Sheets("Control Point Log").Range("A1:A700"), 0)
If (Err.Number = 1004) Then
MsgBox "No match found for this shape text in the Control Point Log"
Exit Sub
End If
On Error GoTo 0
.Hyperlinks.Add Anchor:=CallerShape, _
Address:=ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & RowVar
Else
RowVar = Application.WorksheetFunction _
.Match(.Range("C2").Value & CallerShape.TextFrame2.TextRange.Text, _
Sheets("Data Flow Glossary").Range("A1:A700"), 0)
If (Err.Number = 1004) Then
MsgBox "No match found for this shape text in the Data Flow Glossary"
Exit Sub
End If
On Error GoTo 0
.Hyperlinks.Add Anchor:=CallerShape, _
Address:=ActiveWorkbook.Name & "#" & "'Data Flow Glossary'!$C$" & RowVar
End If
End With
End Sub
1st. I assume that your goal is to navigate to range within your workbook after you click on the shape
2nd. The range to navigate to is named range.
3rd. The range to navigate equals the text in the shape.
My proposal is to use onAction trigger of shape (assign macro when right click of the shape)
4rd. We need the following procedure- one for all shapes.
Sub Hyperlink_Workaround()
On Error GoTo ErrorHandler
Dim curHL As String
curHL = ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Text
'which way do you define destination?
'this way you go to named range
Application.Goto Range(curHL), True
Exit Sub
ErrorHandler:
MsgBox "There is no range like " & curHL
End Sub
5th. Test, having the following shapes on the sheet with above macro assigned, after click on any of the shape we would move to either ABC or DEF Range within our workbook.
6th. I added handler for situation when you try to navigate to the range that doesn't exist.