I needed to pull multiple vlookup values into a single cell. To do so I used vba to create a public function called MULTIVLOOKUP and it works perfectly resulting in the following values in a single cell:
Vendor, Site, ARO, ARO, ARO, Site
The formula to get this is: =MULTIVLOOKUP($J9, $A$2:$A$5000, 4)
I then used code found here on stackoverflow to remove dupes. Here is that code which user KazJaw was great in providing:
Function UniqueFromCell(rngCell, splitString)
Dim myCol As New Collection
Dim itmCol
Dim i As Long
Dim arrTMP As Variant
arrTMP = Split(rngCell, splitString)
For i = 1 To UBound(arrTMP)
On Error Resume Next
myCol.Add arrTMP(i), CStr(arrTMP(i))
On Error GoTo 0
Next i
Dim result
For Each itmCol In myCol
result = result & itmCol & splitString
Next
UniqueFromCell = Left(result, Len(result) - Len(splitString))
End Function
My resulting formula become:
=UNIQUEFROMCELL(MULTIVLOOKUP($J9, $A$2:$A$5000, 4), ",").
It works almost perfect except my result is: Site, ARO
I lost Vendor!
Any suggestions? Thank you in advance.
The line:
For i = 1 To UBound(arrTMP)
Is the problem. Split is returning a zero-based array not a one-based array. It's safer to write something like LBound(arrTMP) instead, to handle both kinds of array properly.
For i = LBound(arrTMP) To UBound(arrTMP)
You can read up on how arrays work in VBA here.
Related
VBA does not let me apply to the particular element in the dynamical array.
Dim a() As Variant
a = Range("A2:A11").Value
Range("B2:B11").Value = a 'Just to make sure that the list is not empty and is working correctly.
MsgBox a(1) 'OR a(7)=0 OR IF a(4)=0 then MsgBox "!"
I expect to use the first element of the array a, but get an error message at the fourth line, trying to execute MsgBox a(1) or any expression, which involves arr_name(num_index)). I tried the identical code with the static array, which works without any problems:
Dim b(10) As Variant
b(1) = 1234
MsgBox b(1)
The debugger also says that "subscript is out of range". At the same time, The array is for sure not void since the 3rd line works correctly and the array from a is copied to the array of neighboring cells and displayed there just a moment before the macros stops and I'm getting the error message.
What is wrong with my code?
This Code:
Dim a() As Variant
a = Range("A2:A11").Value
Range("B2:B11").Value = a
Will give you a 2-D array. To get the Elements of a 2-D array you need to do
MsgBox a(1,1)
MsgBox a(2,1)
and so on.
Also, You can check the Locals Window for all the Objects.
You are using a 2D array
Dim a() As Variant
a = Range("A2:A11").Value
Range("B2:B11").Value = a 'Just to make sure that the list is not empty and is working correctly.
MsgBox a(1,1)
If you want to browse your 2D array You might do as follow, Hope this help :
For element= LBound(a, 1) To UBound(a, 1)
Debug.Print a(element, 1)
Next
All I want to do is reference a collection in a formula. Like
Assume I already know how to make collections and arrays and have done so in my macro, Collection is literally a collection with only 1 column, and Textstring is an array vector.
'For every value of i in Textstring, I want to count the occurrence of that value in all the values of 'Collection'
For i = 1 to Whatever
=COUNTIF(Collection, """ & TextString(i) & """)
Next i
What I want to know is how to make aforementioned code work.
It should work like a normal countif:
'ie: "=COUNTIF('Sheet1'!A1:A10, ""blah"")"
You can't with COUNTIF, if you have a look at the arguments to the function, it expects a Range object.
The only suggestion I have is to do something like the below, i.e. write it out to a worksheet and then use that range as a parameter to your function ...
Public Sub CollectionToRange()
Dim objCollection As New Collection, i As Long
For i = 1 To 10
objCollection.Add i
Next
' Convert the collection to a range.
For i = 1 To objCollection.Count
Sheet1.Cells(i, 1) = objCollection.Item(i)
Next
' Pass the range into the worksheet function.
Debug.Print "CountIf Result = " & WorksheetFunction.CountIf(Sheet1.Range("A1:A" & objCollection.Count), ">3")
' Perform a clean up if required.
End Sub
Not sure if that helps or not.
This is a segment of code that has been troubling me, as I feel certain some simple function exists that will make looping through the array values redundant.
Instead I have used an array, a loop and a boolean to tell me whether the cells are empty (or test their length) and an If statement to run the last part of the code.
I thought perhaps Max would work but I believe that is only for integers. (See the debug.print part
Dim arrArchLoc As Variant
Dim boolArchLoc As Boolean
Dim rowCounter As Long
boolArchLocEmpty = False
arrArchLoc = ActiveSheet.Range(Cells(2, colArchiveLocation), Cells(lastRow, colArchiveLocation))
For rowCounter = LBound(arrArchLoc) To UBound(arrArchLoc)
If Cells(rowCounter, colArchiveLocation) <> "" Then boolArchLocEmpty = True
Next rowCounter
'Debug.Print workshetfunction.Max(arrArchLoc)
If boolArchLocEmpty = True Then
ActiveSheet.Cells(1, colArchiveLocation).Value = "Arch Loc"
Columns(colArchiveLocation).ColumnWidth = 6
End If
Does such a function or simple method exist?
EDIT:
Whilst that specialcells(xlCellTypeBlanks) solution looks pretty good, I would still rather get the string length solution.
My apologies, the code initially had something like...
If len(Cells(rowCounter, colArchiveLocation)) > 6 then...
but I have since removed it after having to get something in place that would work.
Is there something I could do with LEN(MAX)? I experimented with it but didn't get very far.
Given the range is A2:A100, the result you want would be expressed on the sheet as an array formula:
={MAX(LEN(A2:A100))}
In order to execute that from VBA as an array formula and not a regular formula, you need to use Evaluate:
max_len = Evaluate("=MAX(LEN(A2:A100))")
Or, in terms of your code,
Dim arrArchLoc As Range
With ActiveSheet
Set arrArchLoc = .Range(.Cells(2, colArchiveLocation), .Cells(lastRow, colArchiveLocation))
End With
Dim max_len As Long
max_len = Application.Evaluate("=MAX(LEN(" & arrArchLoc.Address(external:=True) & "))")
However it is much better to calculate it explicitly with a loop, like you were already doing.
Why not something like so
activesheet.range(cells(1,1),cells(10,1)).specialcells(xlCellTypeBlanks)
Another way to check if the range is empty or not
Sub Sample()
Debug.Print DoesRangeHaveEmptyCell(Range("A1:A10")) '<~~ Change as applicable
End Sub
Function DoesRangeHaveEmptyCell(rng As Range) As Boolean
If rng.Cells.Count = Application.WorksheetFunction.CountA(rng) Then _
DoesRangeHaveEmptyCell = False Else DoesRangeHaveEmptyCell = True
End Function
I have two files one is a Project Register that holds key information on a project and the other is a Risk log.
There is a 1:m relationship between entries in the Register and the Risk log. What I need to do is combine all of a project risks into one cell inside the project register file.
The matching field in both files is the Project ID field
Is there a way I can do this using a vlookup variant or multiple nested vlookups?
Here's the user-defined function approach I mentioned (adapted from a different VLOOKUP-variant I already had made):
' Acts like VLOOKUP in a 1-to-many scenario by concatenating all values in matching rows
' instead of just returning the first match
Public Function VLOOKUP_MANY(lookup_value As String, lookup_range As Range, column_number As Integer, Optional delimiter As Variant) As Variant
Dim vArr As Variant
Dim i As Long
Dim found As Boolean: found = False
' Set default delimiter
If IsMissing(delimiter) Then delimiter = ", "
' Get values
vArr = lookup_range.Value2
' If column_number is outside of the specified range, return #REF
If column_number < LBound(vArr, 2) Or column_number > UBound(vArr, 2) Then
VLOOKUP_MANY = CVErr(xlErrRef)
Exit Function
End If
' Search for matches and build a concatenated list
VLOOKUP_MANY = ""
For i = 1 To UBound(vArr, 1)
If UCase(vArr(i, 1)) = UCase(lookup_value) Then
VLOOKUP_MANY = VLOOKUP_MANY & delimiter & vArr(i, column_number)
found = True ' Mark at least 1 result
End If
Next
If found Then
VLOOKUP_MANY = Right(VLOOKUP_MANY, Len(VLOOKUP_MANY) - Len(delimiter)) ' Remove first delimiter
Else
VLOOKUP_MANY = CVErr(xlErrNA) ' If no matches found, return #N/A
End If
End Function
This will search the first column in the specified range for the specified value (same as VLOOKUP), but returns the values in the specified column number concatenated. It will return #N/A when no matches are found, and #REF if an invalid value is specified for the column number (e.g. you choose column 5 but only had a 4-column table).
In case you don't know about user-defined functions - you can just copy this VBA code into the VBE for a module in your workbook. Hit Alt+F11, go to Insert > Module at the top of the screen, then paste this code into the blank file that opens up. When you go to save, you'll have to save your workbook as Macro-Enabled (.xlsm) to keep the code working - Excel will remind you about this in the save screen.
Be forewarned: it's going to be slower than VLOOKUP as a result of having to look through the entire lookup range instead of being able to stop at the first match it finds.
If you're open to using an array formula instead, there are ways to speed up this sort of functionality for very large datasets...
Different version that leverages some of the benefits of array formulas to store lookup values and speedup subsequent calls:
' Acts like VLOOKUP in a 1-to-many scenario by concatenating all values in matching rows
' instead of just returning the first match
' Utilizes a dictionary to speedup multiple matches (great for array formulas)
Public Function VLOOKUP_MANY_ARRAY(lookup_values As Range, lookup_range As Range, column_number As Integer, Optional delimiter As Variant) As Variant
Dim vHaystack As Variant, vNeedles As Variant
Dim i As Long
Dim found As Boolean: found = False
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
' Set default delimiter
If IsMissing(delimiter) Then delimiter = ", "
' Get values
vHaystack = lookup_range
vNeedles = lookup_values
' If column_number is outside of the specified range, return #REF
If column_number < LBound(vHaystack, 2) Or column_number > UBound(vHaystack, 2) Then
VLOOKUP_MANY_ARRAY = CVErr(xlErrRef)
Exit Function
End If
' Add values to a lookup dictionary
For i = 1 To UBound(vHaystack, 1)
If dict.Exists(UCase(vHaystack(i, 1))) Then
dict.Item(UCase(vHaystack(i, 1))) = dict.Item(UCase(vHaystack(i, 1))) & delimiter & vHaystack(i, column_number)
Else
dict.Add UCase(vHaystack(i, 1)), vHaystack(i, column_number)
End If
Next
Dim outArr As Variant
If IsArray(vNeedles) Then ' Check number of lookup cells
' Build output array
ReDim outArr(1 To UBound(vNeedles, 1), 1 To 1) As Variant
For i = 1 To UBound(vNeedles, 1)
If dict.Exists(UCase(vNeedles(i, 1))) Then
outArr(i, 1) = dict.Item(UCase(vNeedles(i, 1)))
Else
outArr(i, 1) = CVErr(xlErrNA)
End If
Next
Else
' Single output value
If dict.Exists(UCase(vNeedles)) Then
outArr = dict.Item(UCase(vNeedles))
Else
outArr = CVErr(xlErrNA)
End If
End If
VLOOKUP_MANY_ARRAY = outArr
End Function
This creates a Dictionary, which is a special structure that's really good for looking up values. There's a little extra overhead involved in building it, but once you have the structure, you can do lookups into it very quickly. This is especially nice with array formulas, which is basically when the exact same formula gets put into a whole collection of cells, then the function executes once and returns values for every cell (instead of just executing once, separately, for a bunch of cells). Enter it like an array formula with CTRL+SHIFT+ENTER, and make the first argument refer to all your lookup values instead of just one.
It will work without being used as an array formula, but it will be somewhat slower than the first function in that situation. However, if you use it in an array formula, you'll see huge speedups.
RE-EDIT:
You might need to write a user defined function or write a macro (code on same link)
I use check boxes on individual worksheets to set ranges for performing VLookup functions. One of the check boxes needs to set two distinct ranges in which to search. I'm out of ideas on how to make this work. All the other possible variants are searching a continuous string of cells (i.e. [S9:T20] or [S55:T66] but not both. If I end up having to u multiple variables and perform the function twice the rest of my code will probably not work. Any ideas would be appreciated including if some sort of Find function might do similar work.
Below are snippets of the code that I use:
Dim rngO As Variant
ElseIf ActiveSheet.Shapes("Check Box 43").ControlFormat.Value = 1 Then
rngO = [S9:T20;S55:T66]
The rngO variant is used as shown below (one example):
Case 2
With ActiveSheet
.Range("U2").Value = "1Y"
.Range("V2").Value = WorksheetFunction.VLookup("1Y", rngO, 2, False)
.Range("U3").Value = "1P"
.Range("V3").Value = WorksheetFunction.VLookup("1P", rngO, 2, False)
.Range("U4").Value = "."
.Range("V4").Value = "."
short answer: Yes - it is!
longer answer:
You wrap the WorksheetFunction.VLookup() by some code looking at each area of your source range individually.
Function MyVLookup(Arg As Variant, Source As Range, ColNum As Integer, Optional CmpSwitch As Boolean = True) As Variant
Dim Idx As Integer
MyVLookup = CVErr(xlErrNA) ' default return value if nothing found
On Error Resume Next ' trap 1004 error if Arg is not found
For Idx = 1 To Source.Areas.Count
MyVLookup = WorksheetFunction.VLookup(Arg, Source.Areas(Idx), ColNum, CmpSwitch)
If Not IsError(MyVLookup) Then Exit For ' stop after 1st match
Next Idx
End Function
and in your original code replace all calls to WorksheetFunction.VLookup() by calls to MyVLookup() with the same parameters.
Alternatively you can use this function directly in a cell formula (that's what I usually do with it ...)