Basically this is supposed to be a modified INDEX/MATCH formula but will depend on variables and headers on another workbook, as well as hopefully make it easier on the user by only requiring them to provide two parameters.
Option Compare Text
Function DATAFILL(ID_number, source_headerRow) As Variant
ID_header_name = Cells.Item(1, ID_number.column).Value
Dim wb As String, ws As String
Dim ID_src As Range
'check if source_headerRow is an external workbook
If source_headerRow Like "'" Then
src = Split(source_headerRow.address(External:=True), "!")(0)
wb = Replace(Split(src, "]")(0),"[","")
ws = Split(src, "]")(1)
id_col = Application.WorksheetFunction.Match(ID_header_name, source, 0)
Set ID_src = Workbooks(wb).Worksheets(ws).Range(Cells(1, id_col))
Else
Set ID_src = Range(Cells(1, Application.WorksheetFunction.Match(ID_header_name, source_headerRow, 0)))
End If
headername = "Shift" 'placeholder
Set addr = Workbooks(wb).Range("A:Z")
DATAFILL = Application.WorksheetFunction.Index(addr, Application.WorksheetFunction.Match(ID_number, ID_src), Application.WorksheetFunction.Match(headername, source_headerRow, 0))
End Function
I'm very new to VBA so I can't pinpoint exactly where I'm going wrong...
No matter what I do, I get #VALUE! error.
Or is there a way to make INDEX/MATCH user friendly without needing VBA/Macros?
You don't say what line is give you the VALUE error. That would help.
Or is it in a specific cell?
You haven't defined "addr" variable type anywhere that I can see
and you don't have OPTION EXPLICIT at the top, so by default "addr" wil be a Variant data type.
It needs to be Object at minimum and preferably Range
You should add Option Explicit to the top of your module (above Option Compare Text) and recompile until you can fix all the errors (if there are more)
Related
I am getting issues in using a dictionary in VBA. I want to add values from a sheet to a dictionary. If I use simple lists, there is no error in the code. Like this.
Function Account(Place As String) As String
Dim cities(500)
Dim accounts(500)
For i = 2 To 500
cities(i) = Worksheets("Sheet2").Cells(i, 2).Value
accounts(i) = Worksheets("Sheet2").Cells(i, 3).Value
Next i
placeName = StrConv(Place, vbProperCase)
Account = placeName
End Function
This code does not give an issue but if I add the code for the dictionary, there is some issue.
Function Account(Place As String) As String
Dim cities(500)
Dim accounts(500)
Dim dict
Set dict = CreateObject(Scripting.Dictionary)
For i = 2 To 500
cities(i) = Worksheets("Sheet2").Cells(i, 2).Value
accounts(i) = Worksheets("Sheet2").Cells(i, 3).Value
dict(cities(i)) = accounts(i)
Next i
placeName = StrConv(Place, vbProperCase)
Account = placeName
dict = Nothing
End Function
Can someone point out the error. I am new to vba so I dont know much about it.
The folowing UDF loads a dictionary object with places as keys (unique) and associated accounts as items. After the dictionary has been loaded, it looks up the Place parameter passed into the function and returns the account if found.
Option Explicit
Function Account(Place As String) As String
Static d As Long, dict As Object
If dict Is Nothing Then
Set dict = CreateObject("Scripting.Dictionary")
dict.comparemode = vbTextCompare
Else
dict.RemoveAll
End If
With Worksheets("Sheet2")
For d = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
dict.Item(.Cells(d, "B").Value2) = .Cells(d, "C").Value2
Next d
End With
If dict.exists(Place) Then
Account = dict.Item(Place)
Else
Account = "not found"
End If
End Function
Note that beyond other corrections, the code to instantiate the dictionary object is CreateObject("Scripting.Dictionary") not CreateObject(Scripting.Dictionary).
One possible area of concern, brought to mind by one of your comments, lies in the use of "Sheet1" and "Sheet2". In Excel VBA, there are two different ways to refer to a worksheet. The is the Name of the worksheet, which is what the user sees on the tabs in Excel, and the user can change at will. Thtese default to names like "Sheet1", "Sheet2", etc.
There is also the "Codename" for each worksheet. In the Visual Basic Editor, the project explorer window will list all the worksheets under "Microsoft Excel Objects". There you'll see the Codename for each worksheet, with the Name of the worksheet in parentheses.
When you use Worksheets("Sheet1"), the "Sheet1" refers to the Name, not the Codename. It's possible to end up with a worksheet with the Name "Sheet1" and the codename "Sheet2".
As far as your functions are concerned, I note that in both cases you declare local variables -- the arrays 'cities' and 'accounts' in the first, and those two plus the dictionary 'dict' in the second. You have code to fill those local variables, but then do nothing with them. The return value of the function is not dependent on any of those local variables.
Once the function code completes, those local variables lose their values. VBA returns the memory it used to store those variables to its pool of available memory, to be reused for other purposes.
Try commenting-out the entire for...next loop, and you'll see that the value return from the function is unchanged.
I'm not certain what you intend to accomplish in these functions. It would be helpful for you to explain that.
I've started to use Macros this weekend (I tend to pick up quickly in regards to computers). So far I've been able to get by with searching for answers when I have questions, but my understanding is so limited I'm to a point where I'm no longer understanding the answers. I am writing a function using VBA for Excel. I'd like the function to result in a range, that can then be used as a variable for another function later. This is the code that I have:
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = InputBox("Starting Column:")
R = InputBox("Starting Row:")
cNum = Range(C & 1).Column
Cells(R, cNum).Select
The code up to here works. It selects the cell and all is well in the world.
Set StartingCell = Range(Cell.Address)
End Function
I suppose I have no idea how to save this location as the StartingCell(). I used the same code as I had seen in another very similar situation with the "= Range(Cell.Address)." But that's not working here. Any ideas? Do I need to give more information for help? Thanks for your input!
Edit: I forgot to add that I'm using the InputBox to select the starting cell because I will be reusing this code with multiple data sets and will need to put each data set in a different location, each time this will follow the same population pattern.
Thank you A.S.H & Shai Rado
I've updated the code to:
Function selectQuadrant() As Range
Dim myRange As Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
Set selectQuadrant = myRange
End Function
This is working well. (It appears that text is supposed to show "Enter a range:" but it only showed "Input" for the InputBox. Possibly this could be because I'm on a Mac?
Anyhow. I was able to call the function and set it to a new variable in my other code. But I'm doing something similar to set a long (for a color) so I can select cells of a certain color within a range but I'm getting all kinds of Object errors here as well. I really don't understand it. (And I think I'm dealing with more issues because, being on a mac, I don't have the typical window to edit my macros. Just me, basically a text box and the internet.
So. Here also is the Function for the Color and the Sub that is using the functions. (I've edited both so much I'm not sure where I started or where the error is.)
I'm using the functions and setting the variables to equal the function results.
Sub SelectQuadrantAndPlanets()
Dim quadrant As Range
Dim planetColor As Long
Set quadrant = selectQuadrant()
Set planetColor = selectPlanetColor() '<This is the row that highlights as an error
Call selectAllPlanets(quadrant, planetColor)
End Sub
This is the function I'm using to select the color that I want to highlight within my range
I would alternately be ok with using the interior color from a range that I select, but I didn't know how to set the interior color as the variable so instead I went with the 1, 2 or 3 in the input box.
Function selectPlanetColor() As Long
Dim Color As Integer
Color = InputBox("What Color" _
& vbNewLine & "1 = Large Planets" _
& vbNewLine & "2 = Medium Planets" _
& vbNewLine & "3 = Small Planets")
Dim LargePlanet As Long
Dim MediumPLanet As Long
Dim smallPlanet As Long
LargePlanet = 5475797
MediumPlanet = 9620956
smallPlanet = 12893591
If Color = 1 Then
selectPlanetColor = LargePlanet
Else
If Color = 2 Then
selectPlanetColor = MediumPlanet
Else
If Color = 3 Then
selectPlanetColor = smallPlanet
End If
End If
End If
End Function
Any help would be amazing. I've been able to do the pieces individually but now drawing them all together into one sub that calls on them is not working out well for me. Thank you VBA community :)
It's much simpler. Just
Set StartingCell = Cells(R, C)
after getting the inputs, then End Function.
The magic of the Cells method is it accepts, for its second parameter, both a number or a character. That is:
Cells(3, 4) <=> Cells(3, "D")
and
Cells(1, 28) <=> Cells(3, "AB")
One more thing, you can prompt the user directly to enter a range, with just one input box, like this:
Dim myRange as Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
The Type:=8 specifies the input prompted for is a Range.
Last thing, since you are in the learning process of VBA, avoid as much as possible:
using the Select and Activate stuff
using unqualified ranges. This refers to anywhere the methods Cells(..) or Range(..) appear without a dot . before them. That usually leads to some random issues, because they refer to the ActiveSheet, which means the behavior of the routine will depend on what is the active worksheet at the moment they run. Avoid this and always refer explicitly from which sheet you define the range.
Continuing your line of thought of selecting the Range bu Selecting the Column and Row using the InputBox, use the Application.InputBox and add the Type at the end to restrict the options of the user to the type you want (Type:= 1 >> String, Type:= 2 >> Number).
Function StartingCell Code
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = Application.InputBox(prompt:="Starting Column:", Type:=2) '<-- type 2 inidcates a String
R = Application.InputBox(prompt:="Starting Row:", Type:=1) '<-- type 1 inidcates a Number
Set StartingCell = Range(Cells(R, C), Cells(R, C))
End Function
Sub TestFunc Code (to test the function)
Sub TestFunc()
Dim StartCell As Range
Dim StartCellAddress As String
Set StartCell = StartingCell '<-- set the Range address to a variable (using the function)
StartCellAddress = StartCell.Address '<-- read the Range address to a String
End Sub
I'm attempting to create a User Defined Function to vlookup into a closed workbook on my machine. The below function works while testing it in VBA, but I get the #VALUE error in Excel when attempting to use the function. Any ideas on this? I believe I may be able to use the VBA Evaluate function to help, but so far have had no luck.
Function CUSIP_Deal_Map(CUSIP As String, DataField As String) As Variant
Dim colIndex As Integer ' for vlookup
Dim invalidDataField As Boolean
invalidDataField = False
' Switch statement, to transform from a "DataField" into a column number to be used in VLookUp
Select Case DataField
Case "Deal"
colIndex = 2
Case "Class"
colIndex = 5
Case "DealNum"
colIndex = 6
Case "Vintage"
colIndex = 11
Case "Pool"
colIndex = 12
Case "Index"
colIndex = 13
Case Else
invalidDataField = True
End Select
'Dim wbk As Workbook
Set wbk = Workbooks.Open("C:\CUSIP_Map.xlsx") 'hard code location
Dim VLU_data As Variant
VLU_data = wbk.Application.WorksheetFunction.VLookup(CUSIP, Worksheets("CUSIP_Map").Range("A:M"), colIndex, False) 'vlookup data from "database"
Call wbk.Close(False) 'close connection
' Return data
If invalidDataField Then
CUSIP_Deal_Map = "Invalid DataField"
Else
CUSIP_Deal_Map = VLU_data
End If
End Function
The intended use in Excel would be to utilize a formula like =CUSIP_Deal_Map("123ABC","Deal")
I can test this in VBA, using this code, which returns the value I'm expecting:
Sub test()
MsgBox CUSIP_Deal_Map("123ABC", "Deal")
End Sub
Still, this doesn't work within Excel itself. I found a "pull" UDF online which seems to do something similar, but have been unsuccessful modifying it for my purposes.
That is because a UDF() call from within a Sub can open a file, but the same UDF() called from a worksheet cell cannot.
EDIT#1:
insure the UDF is in a standard module.
at the very top of the module include Public wbk as Workbook
create a workbook Open event macro in your workbook code area to open the secondary workbook and initialize wbk
OK, with the limitation already brokered by Gary's Student, you may want to rethink the idea of a UDF altogether. With those values from the Select Case statement in the first row of the closed CUSIP_Map worksheet, either of these standard worksheet formulas will do.
=VLOOKUP(A1, 'C:\[CUSIP_Map.xlsx]CUSIP_Map'!$A:$M, MATCH("Vintage", 'C:\[CUSIP_Map.xlsx]CUSIP_Map'!$1:$1, 0), FALSE)
=VLOOKUP(A1, 'C:\[CUSIP_Map.xlsx]CUSIP_Map'!$A:$M, LOOKUP("Class", {"Class","Deal","DealNum","Index","Pool","Vintage"}, {5,2,6,13,12,11}), FALSE)
A1 would be value to look up in the CUSIP_Map's column A. Instead of a VBA select case, the column to return is determined by either a MATCH function of the first row column headers or a hard-coded LOOKUP function of text and column numbers. Note that the LOOKUP has its values in ascending order and that it may not have as much error control as the MATCH as it will attempt partial matches. An IFERROR function as a wrapper can return "Invalid DataField" on MATCH errors.
I am new to VBA coding and am attempting to build a Vlookup to connect two seperate workbooks. Provided belwo is my coding which is currently producing a Run-Time 1004 Method 'Range' of Object'_Global' Failed error on the vlookup line.
Sub dataEntry(agent As Integer, month As Integer)
Dim lookupReturn As Integer
Dim i As Integer
Dim lookupValue As String
Dim lookupBook As String
i = 1
'set excel book to preform vlookup within
lookupBook = sheetName & "-Daily Report Daily-Monthly Grid.xlsx"
'Preforms a Vlookup to fill in data points
Do While Workbooks("Cumulative Agent Ranking Template").Sheets(sheetName).Cells(i, 1).Value <> ""
lookupValue = Workbooks("Cumulative Agent Ranking Template").Sheets(sheetName).Cells(i, 10).Value
lookupReturn = Sheets(sheetName).WorksheetFunction.VLookup(Range("C2"), [lookupBook] & sheet33 & Range("!$A$2" & ":$C" & agent), 2, False)
Workbooks("Cumulative Agent Ranking Template").Sheets(sheetName).Cells(i, 11).Value = lookupReturn
i = i + 1
lookupValue = ""
lookupReturn = 0
Loop
I think there are probably a lot of things going wrong here.
Let's start with the most obvious source of 1004 error, which is unqualified range objects.
Example: in a standard module, Range("C2") always refers to the Active sheet. In a sheet module, it always refers to the parent sheet.
To Resolve: fully qualify your range variables, e.g., Workbooks(_name_).Worksheets(_sheetname_).Range("C2")
Another potential problem I notice is the way you're calling the Vlookup.
Sheets(sheetName).WorksheetFunction...
There is no such method WorksheetFunction of a worksheet object. This is an application-level method, so invoke it like:
WorksheetFunction.Vlookup...
Additional problems or potential problems
Undeclared variables: sheetname (maybe this is a public or module-level variable?)
Unused variables: lookupValue You've declared this, and you've assigned to it, but you haven't done anything to it or used it anywhere else in the code. is this the value you're trying to search for?
The rest of your formula is also pretty gnarly and I'm not even going to try and fix it in its current state. If you use better-defined object variables, your code will be easier to read and understand. You will also benefit from intellisense if the variables are strongly typed in declaration.
Here is an example, which I will leave up to you to work out for your own needs:
Dim lookupBook as Workbook
Dim lookupRange as Range
Dim lookupValue as String
Set lookupBook = Workbooks("some other file.xlsx")
Set lookupRange = lookupBook.Worksheets("some worksheet").Range("A1:B50")
lookupValue = "cat"
Range("A1").Value = WorksheetFunction.Vlookup(lookupValue, lookupRange, 2, False)
For a given cell, I select Data/Validation and set Allow to "List". I now wish to set Source like so:
=rNames(REGS)
but that does not work (name not found). So I go Insert/Name/Define and create "REGNAMES" by simply assigning the formula above (no cell range). I then return to the Data/Validation and when I set Source like so:
=REGNAMES
Now I get "Source currently evaluates to error". Unfortunately, this error does not go away even after I ignore it. I can create a range formula in the sheet like so:
{=REGNAMES}
and drag this to the right across a couple cells and the rNames function faithfully returns
Option #1 | Options #2 | ...
That is, the function returns a range as intended.
I know that I can use macro code to manipulate the List setting for that cell out of VBA. I don't like these side-effects much. I would prefer a clean dependency tree built on functions. Any ideas how to get the Data/Validation to accept the array values returned from rNames?
Thanks.
PS: rNames returns the result range as a Variant, if that has any bearing.
I think the problem is that data validation dialog only accepts the following "lists":
an actual list of things entered directly into the Source field
a literal range reference (like $Q$42:$Q$50)
a named formula that itself resolves to a range reference
That last one is key - there is no way to have a VBA function just return an array that can be used for validation, even if you call it from a named formula.
You can write a VBA function that returns a range reference, though, and call that from a named formula. This can be useful as part of the following technique that approximates the ability to do what you actually want.
First, have an actual range somewhere that calls your arbitrary-array-returning VBA UDF. Say you had this function:
Public Function validationList(someArg, someOtherArg)
'Pretend this got calculated somehow based on the above args...
validationList = Array("a", "b", "c")
End Function
And you called it from $Q$42:$Q$50 as an array formula. You'd get three cells with "a", "b", and "c" in them, and the rest of the cells would have #N/A errors because the returned array was smaller than the range that called the UDF. So far so good.
Now, have another VBA UDF that returns just the "occupied" part of a range, ignoring the #N/A error cells:
Public Function extractSeq(rng As Range)
'On Error GoTo EH stuff omitted...
'Also omitting validation - is range only one row or column, etc.
Dim posLast As Long
For posLast = rng.Count To 1 Step -1
If Not IsError(rng(posLast)) Then
Exit For
End If
If rng(posLast) <> CVErr(xlErrNA) Then
Exit For
End If
Next posLast
If posLast < 1 Then
extractSeq = CVErr(xlErrRef)
Else
Set extractSeq = Range(rng(1), rng(posLast))
End If
End Function
You can then call this from a named formula like so:
=extractSeq($Q$42:$Q$50)
and the named formula will return a range reference that Excel will accept an allowable validation list. Clunky, but side-effect free!
Note the use of the keyword 'Set' in the above code. It's not clear from your question, but this might be the only part of this whole answer that matters to you. If you don't use 'Set' when trying to return a range reference, VBA will instead return the value of the range, which can't be used as a validation list.
I was just doing some research on accessing the contents of a Shapes dropdown control, and discovered another approach to solving this problem that you might find helpful.
Any range that can have a validation rule applied can have that rule applied programmatically. Thus, if you want to apply a rule to cell A1, you can do this:
ActiveSheet.Range("A1").Validation.Add xlValidateList, , , "use, this, list"
The above adds an in-cell dropdown validation that contains the items "use," "this," and "list." If you override the Worksheet_SelectionChange() event, and check for specific ranges within it, you can call any number of routines to create/delete validation rules. The beauty of this method is that the list referred to can be any list that can be created in VBA. I needed a dynamically-generated list of an ever-changing subset of the worksheets in a workbook, which I then concatenated together to create the validation list.
In the Worksheet_SelectionChange() event, I check for the range and then if it matches, fire the validation rule sub, thus:
Private Sub Worksheet_SelectionChange(ByVal Target as Range)
If Target.Address = "$A$1" Then
UpdateValidation
End If
End Sub
The validation list-builder code in UpdateValidation() does this:
Public Sub UpdateValidation()
Dim sList as String
Dim oSheet as Worksheet
For Each oSheet in Worksheets
sList = sList & oSheet.Name & ","
Next
sList = left(sList, len(sList) -1) ' Trim off the trailing comma
ActiveSheet.Range("A1").Validation.Delete
ActiveSheet.Range("A1").Validation.Add xlValidateList, , , sList
End Sub
And now, when the user clicks the dropdown arrow, he/she will be presented with the updated validation list.
Sounds like your rNames function is probably returning a 1-dimensional array (which will be treated as a row).
Try making your function return a column as a 1-based 2-dimensional array (Ansa(1,1) then Ansa(2,1) etc)
Couln't you rather use dynamic range names ? That's quite easy and does not require any vba.
For the future:
Following is then used in a named range and the named range set as the 'Data Validation' 'List' value
Function uniqueList(R_NonUnique As Range) As Variant
Dim R_TempList As Range
Dim V_Iterator As Variant
Dim C_UniqueItems As New Collection
On Error Resume Next
For Each V_Iterator In R_NonUnique
C_UniqueItems.Add "'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, CStr(V_Iterator.Value2)
Next V_Iterator
On Error GoTo 0
For Each V_Iterator In C_UniqueItems
If R_TempList Is Nothing Then
Set R_TempList = Range(V_Iterator)
End If
Set R_TempList = Union(R_TempList, Range(V_Iterator))
Next V_Iterator
Set uniqueList = R_TempList
End Function
#user5149293 I higly appreciate your code, but I recommend to prevent the collection from throwing an error, when adding duplicate values. The usage of a custom formula in the data validation list or in Name-Manager-Formula prevents the code from using the vbe debugger, which makes it very hard to trace back errors here (I ran into this problem myself, when using your code).
I recommend to check the existence of key in the collection with a separate function:
Function uniqueList(R_NonUnique As Range) As Variant
'Returns unique list as Array
Dim R_TempList As Range
Dim V_Iterator As Variant
Dim C_UniqueItems As New Collection
For Each V_Iterator In R_NonUnique
'Check if key already exists in the Collection
If Not HasKey(C_UniqueItems, V_Iterator.Value2) Then
C_UniqueItems.Add Item:="'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, Key:=CStr(V_Iterator.Value2)
End If
Next V_Iterator
For Each V_Iterator In C_UniqueItems
If R_TempList Is Nothing Then
Set R_TempList = Range(V_Iterator)
End If
Set R_TempList = Union(R_TempList, Range(V_Iterator))
Next V_Iterator
Set uniqueList = R_TempList
End Function
Function HasKey(coll As Collection, strKey As String) As Boolean
'https://stackoverflow.com/questions/38007844/generic-way-to-check-if-a-key-is-in-a-collection-in-excel-vba
Dim var As Variant
On Error Resume Next
var = coll(strKey)
HasKey = (Err.Number = 0)
Err.Clear
End Function