I'm relatively new to Excel-Vb. I basically want to extract multiple values from a single cell and assign it to multiple variables. For eg.,
A single cell in an excel contains value in the format (0.1:0.2:10). I need to assign these values in a cell to three different variables. My code should look something like this,
Public DeviceInfo (Optional ByVal rng As Range = Nothing)
If (Len(rng.Cells(1)) > 0 Then
rng.Cells(1) = 'This is where I'm not sure how to delimit colon
'in my cell value and assign it to different
'variables
End If
End Sub
So ideally, the o/p should be the values in the cell 0.1, 0.2, 10 should assigned to Variable 1, variable2, variable3 respectively. Can someone help?
As per understanding of your problem, You can write code as below it works
you need to supply cell as range and position value like if (A1="0.1:0.2:10")
=DeviceInfo(A1,0)'output is 0.1
=DeviceInfo(A1,1)'output is 0.2
=DeviceInfo(A1,2)'output is 10
'''
Public Function DeviceInfo(rng As Range, val As Integer)
'This function split string "0.1:0.2:10" on the basis of char ":"
'required input rng as informat of "0.1:0.2:10" and val as position of string after split
Dim LArray() As String 'Dim for output array
LArray = Split(rng.Value, ":") 'split on basis of ":" char
If Application.WorksheetFunction.IsNumber(val) = True Then
DeviceInfo = LArray(val)
Else
DeviceInfo = "Not Number"
End If
End Function
Related
I create complex numbers in Excel for example with =COMPLEX(ROUND(A10;3);ROUND(B10;3)). However, if either the real or imaginary part is 0, it gets dropped, like 0.500 instead of 0.500 + 0.000i or 0.800i instead of 0.000 + 0.800i. It looks awful in tables. Using FIXED instead of ROUND gives the same result.
How can I get this formatted properly?
Thanks in advance
Engelbert
Based on the answer I linked in my comment above, here is an example of a UDF that will format complex numbers and include the zero value. The bonus in this function is that it will handle both a Range input (as a single cell) or a numerical value.
Option Explicit
Public Function FormatComplex(r As Variant, _
Optional i As Variant, _
Optional fmt As String = "0.000") As String
'--- returns a formatting string depicting the complex number
' represented by r and i. these parameters may be given as
' a (single cell) range, or a value
' INPUTS: r can be a (single-cell) Range or a value represented
' as a string, double, integer, or complex value
' i can be a (single-cell) Range or a value represented
' as a string, double, integer, or complex value
' (should be omitted if "r" is a Complex value)
' fmt is a VBA style format string (cannot be used if
' the "r" parameter is Complex)
Dim realPart As Double
Dim imgPart As Double
If TypeName(r) = "Range" Then
'--- must be a single cell
If r.Count > 1 Then
FormatComplex = CVErr(xlErrRef)
Exit Function
End If
If Right$(r, 1) = "i" Then
'--- the value given is already assumed to be complex, so
' split up the parts here
realPart = Application.WorksheetFunction.ImReal(r)
imgPart = Application.WorksheetFunction.Imaginary(r)
Else
realPart = r.Value
End If
Else
realPart = r
End If
If Not IsMissing(i) Then
If TypeName(i) = "Range" Then
'--- must be a single cell
If i.Count > 1 Then
FormatComplex = CVErr(xlErrRef)
Exit Function
End If
imgPart = i.Value
Else
imgPart = i
End If
End If
Dim result As String
result = Format(realPart, fmt)
If Left$(fmt, 1) <> "+" Then
'--- if the user-specified format string does not explicitly
' call out a sign, then we have to add it ourselves
' this might be desirable if the user does not want a
' leading "+" in front of the real part
If imgPart >= 0 Then
result = result & "+"
Else
'--- assume the "-" is included in the number formatting
' so don't add it here
End If
End If
result = result & Format(imgPart, fmt) & "i"
FormatComplex = result
End Function
The thing is not always the amount of values (IDs) will be the same within each cell (at least 1, max=several) that's why the fixed version of using concatenated vlookup+left/mid/right will not work for me due to that will solution will only work up to 3 values. The only fixed size is the size of the values to lookup (IDs - in green), 8 characters (letters+numbers).
I'm not sure but, is it possible to setup a loop within excel formulas/functions ?
Below is a table containing an example of the issue I'm trying to resolve and the expected values (tables are in different tab). Hope you can help.
Thanks.
example-tables
If you have windows Excel O365 with the TEXTJOIN and FILTERXML functions, you can use a formula:
=TEXTJOIN(",",TRUE,IFERROR(XLOOKUP(FILTERXML("<t><s>" & SUBSTITUTE(#[IDs],",","</s><s>") & "</s></t>","//s"),Table2[IDs],Table2[IDv2]),"""--"""))
Note that, in your data, there are two ID's in A4 that do not match any ID's in Table 2. Although that may be a typo, I left them as is to demonstrate the error handling.
Table1
Table2
Here is a UDF that will do what you describe. Paste the code into a standard code module (not one already existing in the workbook but one that you create and that would have a name like Module1 before you change it to what you like best. You can also rename the function to give it a more suitable name.
Function ID_v2(Cell As Range) As String
' 035
Dim Fun As String ' function return value
Dim Sp() As String ' array of CSVs of CellVal
Dim VLRng As Range ' the lookup range
Dim VL As Variant ' result of VLookup
Dim i As Integer ' loop counter
' this is a range similar to your sample A10:D19
Set VLRng = ThisWorkbook.Names("Table2").RefersToRange
Sp = Split(Cell.Cells(1).Value, ",")
If UBound(Sp) >= 0 Then
For i = 0 To UBound(Sp)
On Error Resume Next
VL = Application.VLookup(Trim(Sp(i)), VLRng, 3, False)
If Err Then VL = "[ERROR]"
Fun = Fun & VL & ","
Next i
ID_v2 = Left(Fun, Len(Fun) - 1) ' remove final comma
End If
End Function
Call the function with syntax like built-in functions. For example,
= ID_v2(A3)
This can be copied down like any other function. But remember to save the workbook as macro-enabled.
Try this:
Option Explicit
Sub Cell2List()
Dim wF As WorksheetFunction: Set wF = Application.WorksheetFunction 'To user Transpose
Dim i As Range
Dim j As Range
Dim s As String: s = "," 'The separator of the list
'Ask the user for the cell where are the list with the commas
'Just need to select the cell
Set i = Application.InputBox("Select just one cell where the values are", "01. Selecte the values", , , , , , 8)
'Ask the for the separator. If you are completely sure the comma will never change just delete this line
s = Application.InputBox("Tell me, what is the character separator, just one character! (optional)", "02. Separator (comma semicolon colon or any other char)", , , , , , 2)
If s = "" Then s = "," 'Verifying...........
'Ask the user where want to put the list
'You need to get ready the cells to receive the list.
'If there any data will be lost, the macro will overwrite anything in the cells
Set j = Application.InputBox("Select just one cell where the values will go as a list, just one cell!", "03. Selecte the cell", , , , , , 8)
Dim myArr: myArr = (Split(i.Value, s)) 'Split the list into a Array
Range(Cells(j.Row, j.Column), Cells(j.Row + UBound(myArr), j.Column)).Value = wF.Transpose(myArr)
'j.Row is the row of the cell the user selected to put the cell
'j.Column the same, but the column
'j.Row + UBound(myArr) = UBound(myArr) is the total count of elements in the list
' +j.Row
' _______________
' the last cell of the new list!
'wF.Transpose(myArr) = we need to "flip" the array... Don't worry, but Don't change it!
End Sub
You can put this macro with a button tin the ribbons, or use it as you can see in the gif
And this will be the result: (with a bigger list)
EDIT
You can use this UDF:
Function Cells2List(List As Range, Pos As Integer) As String
Cells2List = Split(List, ",")(Pos - 1)
End Function
Just need to define and index this way:
To tell the function, what index you want to see. You can use the function using ROW()-# to define an 1 at the beginning and when the formula send a #VALUE! delete the formulas. Where $A$1 is where the list are, and D7 is where the index are.
Column A contains the list of all counters and column D (onward) contains some related information which I'm extracting from form XML. Now I want to return those variables in column B for which there are multiple values in column D and beyond
For example:
for counter1, nothing should be returned
for counter2, "D" should be
returned as there are 2 unique values(4 and 5) for it
for counter3, "B,C,D" should be returned as there are multiple values for those 3 variables.
Format is standard, variable-value pairs are separated by comma and there is equal sign between variable and value, but there can be as many number of pairs and as many number of key pair instances(one counter can have up to 100+ such cells in front of them)
Going by the assumption that you want to
Search for multiple assignments to a variable of the form X=n and return all variable names that get assigned at least 2 different values. Multiple assignments within one cell are separated by a defined delimiter. A range of multiple cells that do or do not contain one or more assignments may serve as input.
The below function FindDuplicateAssignmentsInCSVRange(inputRange, listDelimiter, assignmentOperator accepts a range of cells and optionally allows to define an alternate list separator (default: comma) and an alternate assignment operator (default: equality symbol).
It outputs as a comma-separated list (or whatever alternate separator has been passed in) the names of all variables that get assigned at least 2 different values. If no variable name fulfills that requirement, an empty string is returned instead.
Option Explicit
Private Type TKeyValuePair
key As String
val As String
End Type
Private Function FindDuplicateAssignmentsInCSVRange(inpRange As Range, _
Optional ByVal listDelimiter As String = ",", _
Optional ByVal assingmentOperator As String = "=") As String
' this function needs a reference to the Microsoft Scripting Runtime to work
Const ReturnIndicator As String = "Return this value's key when done"
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
' Go into each cell in the given range
Dim c As Range
For Each c In inpRange.Cells
' split cell contents and iterate over each particle
Dim particle As Variant
For Each particle In Split(c.Value, listDelimiter)
' split each fragment "A=1" into variable and value; kvp = key-value pair
Dim kvp As TKeyValuePair
kvp.key = Split(particle, assingmentOperator)(0)
kvp.val = Split(particle, assingmentOperator)(1)
If Not dic.Exists(kvp.key) Then
' add new keys/variables to dictionary to keep track
dic.Add kvp.key, kvp.val
Else
' check values of existing keys and mark key if values differ ( = there are 2 or more different values)
Dim AlreadyMarkedForReturn As Boolean
AlreadyMarkedForReturn = (dic(kvp.key) = ReturnIndicator)
If dic(kvp.key) <> kvp.val And Not AlreadyMarkedForReturn Then
dic(kvp.key) = ReturnIndicator
End If
End If
Next particle
Next c
' clean up dictionary to only contain the return entries
Dim k As Variant
For Each k In dic.Keys
If dic(k) <> ReturnIndicator Then dic.Remove k
Next k
' return remaining keys as comma(or whatever)-separated list
FindDuplicateAssignmentsInCSVRange = Join(dic.Keys, listDelimiter)
End Function
Example usage:
Public Sub SO_51607467()
Debug.Print "D2:D2 Variables: '" & FindDuplicateAssignmentsInCSVRange(ThisWorkbook.Sheets(1).Range("D2")) & "'"
Debug.Print "D3:E3 Variables: '" & FindDuplicateAssignmentsInCSVRange(ThisWorkbook.Sheets(1).Range("D3:E3")) & "'"
Debug.Print "D4:F4 Variables: '" & FindDuplicateAssignmentsInCSVRange(ThisWorkbook.Sheets(1).Range("D4:F4")) & "'"
End Sub
Output of running SO_51607467 from within an approximate (due to copy-typing) copy of the workbook you showed:
D2:D2 Variables: ''
D3:E3 Variables: 'D'
D4:F4 Variables: 'B,C'
I'm developing a VBA function for Excel. It will take input parameters of an integer (we'll call it ref_num), and a range. It will search through the range, looking for ref_num as the value of a cell. When it finds ref_num (which may or may not be present), it will go to the second row of the column that ref_num is in, and store that value as a string in the return variable (the value is a date, and 1-31 each have their own column). Every time ref_num is found in a column, the value in the second row will be appended to the return string.
Slightly more concrete example:
ref_num is 2, and 2 occurs in columns A, B, and C. The values in A2, B2, and C2 are 1, 2, and 3, respectively, so the function must return "1, 2, 3".
This is my pseudo-code, but I need some help filling in the blanks...
Note that this currently does not work, and that the algorithm is very much brute force. I just want to get something working.
Function GetDays(ref_num As Integer, range_o_cells As Range) As String
Dim num_dates As Integer
Dim day As String
Set num_dates = 0
'iterate through all the cells and see if the value is ref_num
For Each c In range_o_cells
If c.Value = ref_num Then
'get the cell's column, then reference the second row and get the value. Note that this will be an int that we need to convert to a string
'I seriously doubt the following line will work
day = CStr(Cells(c.Column, 2).Value)
'Once you have the value, append it to the return value
If num_dates = 0 Then
'This is the first value we've found, so we don't need to prepend a comma
GetDays = day
num_dates = 1
Else
'This is probably not valid VBA syntax...
GetDays = GetDays & ", " & day
End If
Next c
End Function
Note that currently, if I call it like this: =GetDays(AG39, $P$3:$W$500) where AG39 is the cell containing ref_num, I get #NUM!
There are multiple issues in your code
You don't use Set for integers
Missing an End If
As you suspected, your indexing into Cells is iffy
You should build your return string into day and assign it to the function in one place
Looping over a range is Slow
You should declare all variables
Better approach is to move the data to a variant array, and loop that. Also include the header data in the range passed to range_o_cells (I'm guessing thats $P$1:$W$500)
Here's your code refactored
Function GetDays( _
ref_num As Long, _
range_o_cells As Range, _
Optional Sep As String = ", ") As String
Dim dat As Variant
Dim rw As Long, col As Long
Dim day As String
dat = range_o_cells.Value
For col = 1 To UBound(dat, 2)
For rw = 3 To UBound(dat, 1)
If dat(rw, col) = ref_num Then
day = day & dat(2, col) & Sep
End If
Next rw, col
If Len(day) > 0 Then day = Left$(day, Len(day) - Len(Sep))
GetDays = day
End Function
I am trying to use a vlookup or similar function to search a worksheet, match account numbers, then return a specified value. My problem is there are duplicate account numbers and I would like the result to concatenate the results into one string.
Acct No CropType
------- ---------
0001 Grain
0001 OilSeed
0001 Hay
0002 Grain
Is in the first worksheet, on the 2nd worksheet I have the Acct No with other information and I need to get all the matching results into one column on the 2nd worksheet ie. "Grain Oilseed Hay"
Here is a function that will do it for you. It's a little different from Vlookup in that you will only give it the search column, not the whole range, then as the third parameter you will tell it how many columns to go left (negative numbers) or right (positive) in order to get your return value.
I also added the option to use a seperator, in your case you will use " ". Here is the function call for you, assuming the first row with Acct No. is A and the results is row B:
=vlookupall("0001", A:A, 1, " ")
Here is the function:
Function VLookupAll(ByVal lookup_value As String, _
ByVal lookup_column As range, _
ByVal return_value_column As Long, _
Optional seperator As String = ", ") As String
Dim i As Long
Dim result As String
For i = 1 To lookup_column.Rows.count
If Len(lookup_column(i, 1).text) <> 0 Then
If lookup_column(i, 1).text = lookup_value Then
result = result & (lookup_column(i).offset(0, return_value_column).text & seperator)
End If
End If
Next
If Len(result) <> 0 Then
result = Left(result, Len(result) - Len(seperator))
End If
VLookupAll = result
End Function
Notes:
I made ", " the default seperator for results if you don't enter one.
If there is one or more hits, I added some checking at the end to
make sure the string doesn't end with an extra seperator.
I've used A:A as the range since I don't know your range, but
obviously it's faster if you enter the actual range.
One way to do this would be to use an array formula to populate all of the matches into a hidden column and then concatenate those values into your string for display:
=IFERROR(INDEX(cropTypeValues,SMALL(IF(accLookup=accNumValues,ROW(accNumValues)-MIN(ROW(accNumValues))+1,""),ROW(A1))),"")
cropTypeValues: Named range holding the list of your crop types.
accLookup: Named range holding the account number to lookup.
accNumValues: Named range holding the list of your account
numbers.
Enter as an array formula (Ctrl+Shift+Enter) and then copy down as far as necessary.
Let me know if you need any part of the formula explaining.
I've just had a similar problem and I have looked up similar solutions for a long time, nothing really convinced me though. Either you had to write a macro, or some special function, while yet, for my needs the easiest solution is to use a pivot table in e.g. Excel.
If you create a new pivot table from your data and first add "Acct No" as row label and then add "CropType" as RowLabel you will have a very nice grouping that lists for each account all the crop types. It won't do that in a single cell though.
Here is my code which even better than an excel vlookup because you can choose to criterie colum, and for sure a separator (Carriege return too)...
Function Lookup_concat(source As String, tableau As Range, separator As String, colSRC As Integer, colDST As Integer) As String
Dim i, y As Integer
Dim result As String
If separator = "CRLF" Then
separator = Chr(10)
End If
y = tableau.Rows.Count
result = ""
For i = 1 To y
If (tableau.Cells(i, colSRC) = source) Then
If result = "" Then
result = tableau.Cells(i, colDST)
Else
result = result & separator & tableau.Cells(i, colDST)
End If
End If
Next
Lookup_concat = result
End Function
And a gift, you can make also a lookup on multiple element of the same cell (based on the same separator). Really usefull
Function Concat_Lookup(source As String, tableau As Range, separator As String, colSRC As Integer, colDST As Integer) As String
Dim i, y As Integer
Dim result As String
Dim Splitted As Variant
If separator = "CRLF" Then
separator = Chr(10)
End If
Splitted = split(source, separator)
y = tableau.Rows.Count
result = ""
For i = 1 To y
For Each word In Splitted
If (tableau.Cells(i, colSRC) = word) Then
If result = "" Then
result = tableau.Cells(i, colDST)
Else
Dim Splitted1 As Variant
Splitted1 = split(result, separator)
If IsInArray(tableau.Cells(i, colDST), Splitted1) = False Then
result = result & separator & tableau.Cells(i, colDST)
End If
End If
End If
Next
Next
Concat_Lookup = result
End Function
Previous sub needs this function
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Function VLookupAll(vValue, rngAll As Range, iCol As Integer, Optional sSep As String = ", ")
Dim rCell As Range
Dim rng As Range
On Error GoTo ErrHandler
Set rng = Intersect(rngAll, rngAll.Columns(1))
For Each rCell In rng
If rCell.Value = vValue Then
VLookupAll = VLookupAll & sSep & rCell.Offset(0, iCol - 1).Value
End If
Next rCell
If VLookupAll = "" Then
VLookupAll = CVErr(xlErrNA)
Else
VLookupAll = Right(VLookupAll, Len(VLookupAll) - Len(sSep))
End If
ErrHandler:
If Err.Number <> 0 Then VLookupAll = CVErr(xlErrValue)
End Function
Use like this:
=VLookupAll(K1, A1:C25, 3)
to look up all occurrences of the value of K1 in the range A1:A25 and to return the corresponding values from column C, separated by commas.
If you want to sum values, you can use SUMIF, for example
=SUMIF(A1:A25, K1, C1:C25)
to sum the values in C1:C25 where the corresponding values in column A equal the value of K1.
ALL D BEST.