function returning letter column and value VBA - excel

I have been reading in different websites how to create a function that gets a string as argument which is the name of a column in excel(The name of the column is defined by the value found in row 4;name, status, phone,etc) and returns two values; The column letter(A,B,C,D,etc.) AND the column title(name, status, phone). So far I have this function that returns the letter of the column where the title is found but I am not sure how to modify this function so it returns the column letter AND the column title as well. The argument for this function is the column title which is retrieved from an array. Probably I cannot use one argument and get two values, no sure. I would appreciate any help. Thank you
Function ColumnLetters(r As Range) As String
Dim i As String
i = r.Address(False, False)
ColumnLetters = Left(i, Len(i) - Len(Format(r.row, "0")))
End Function

Sub Tester()
Dim a
a = ColumnInfo(Range("D10"))
msgbox "Column: " & a(0) & " Header: " & a(1)
End sub
Function ColumnInfo(r As Range)
Set r = r.Cells(1)EntireColumn
ColumnInfo = Array(Replace(r.Cells(1).Address(False, False), "1", ""), _
r.Cells(4).Value)
End Function

Related

Search Column headers Right to Left vba

I have a function to find a column header, but it searches from left to right. I need to find the right most column that matches, so I'd like to search right to left, but I can't figure out how. I tried using xlprevious/xlnext but they gave me the same answer.
Example:
Dim HeaderColFoundRng As Range
Set HeaderColFoundRng = Range("A1:H1").Find("FindStr", , xlValues, xlPart)
Using xlPrevious does seem to work for me:
Set HeaderColFoundRng = Range("A1:H1").Find(What:="FindStr", LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlPrevious)
My guess as to why it didn't work for you is that you perhaps mixed up the argument positions. Using named arguments seems cleaner and easier to read here.
Alternative via worksheet function Filter()
If you dispose of the dynamic Excel function Filter (vs. MS/Excel 365) you can use the following steps:
a) construct a formula pattern returning column numbers (base formula e.g. =FILTER(COLUMN(A1:H1),LEFT(A1:H1,8)="forecast")),
b) evaluate the formula to get 1-based array elements with all found column numbers. - The function returns the most right occurrence (Right2Left) of the searched caption (within each string starting with the passed caption characters) which will be located via Ubound().
Further hints:
The search caption argument is Case insensitive. The Right to left direction can be changed via optional argument Right2Left = False.
Function HeaderCol(rng As Range, Caption As String, _
Optional Right2Left As Boolean = True) As Long
'a) construct formula
Dim addr As String
addr = rng.Address(False, False, external:=True)
Dim n As Long
n = Len(Caption)
Dim myFormula As String
myFormula = "=Filter(column(" & addr & "),Left(" & addr & "," & n & ")=""" & Caption & """)"
'b) get most right occurrence of evaluated formula (if Right2Left)
Dim chk
chk = Evaluate(myFormula)
If IsError(chk) Then Exit Function
HeaderCol = chk(IIf(Right2Left, UBound(chk), 1))
End Function
Possible Example call
Assuming a header row with changing column captions like "Forecast2020", "Forecast2021", "Sales2020", "Sales2021" you might want to get the last occurrence of Forecast data, i.e. the column number of "Forecast2021":
Sub testHeaderCol()
Dim col As Long
col = HeaderCol(Sheet1.Range("A1:H1"), "Forecast")
If col Then
Debug.Print "Found cell: " & Sheet1.Cells(1, col).Address(False, False, external:=True)
'do other stuff, e.g. set range object
'...
Else
Debug.Print "Nothing found!"
End If
End Sub

VBA code to scan through a comma separated value in a cell and retrieve lookup value

I have a scenario where I have to read through values in one cell which is comma separated and retrieve only values from that array to match with a particular lookup value. For eg:
So what I need is a function to retrieve all Task(or any other issuetype which could vary) from row 2 Links column
expected result: Against A2 I want to retrieve A4 and A6
This is something I modified so that you could customize it to any lookup value
Function GetLinkedItem(link As String, targetLinkType As String)
Dim temp(0 To 0) As String
GetLinkedItem = "None"
If Trim(link) = "" Then Exit Function
Dim links() As String, i As Long
links = Split(link, ",")
For i = 0 To UBound(links)
'select the links that are targetLinkType
Dim j As Long
j = GetRow(Trim(links(i)))
If Sheets("Data").Cells(j, ISUUETYPE_COL) = targetLinkType Then
temp(0) = temp(0) & " " & Sheets("Data").Cells(j, ID_COL) & ","
End If
GetLinkedItem = Join(temp, ",")
Next i
End Function
You can create a UDF to perform this lookup. In a new module in your VBE, paste the following:
Function getTasks(tasklist As Range, availabletasks As Range) As String
'tasklist is the incoming array in Column C
'availabletasks is the stuff in Column A
'Array for output
Dim tasks() As String: ReDim tasks(0 To 0)
'Loop through each item in taslist using an array
For Each task In Split(tasklist.Value, ", ")
'Search availabletasks
If Not availabletasks.Find(task) Is Nothing Then
'pop the array
If tasks(0) <> "" Then ReDim Preserve tasks(0 To UBound(tasks) + 1)
tasks(UBound(tasks)) = task
End If
Next
'Return what we found
getTasks = Join(tasks, ", ")
End Function
Now in your spreadsheet you can use this function just like a regular formula:
=getTasks(C1,$A$1:$A$6)
Where C1 has the list like A4, A25, A22, A6, A29, A42 and $A$1:$A$6 are just like your example Column A. This will return A4, A6
Thanks so much. I added the code in a new module and used the function as formula. I was getting just 1 value instead of 2(Just got A4 and not A6).

How to check if the previous and next records are sequential in Excel

I have an excel Spreadsheet of values. I am trying to build a string of values which will look at all the records in the sheet and determine which ones are the same (based on a sequence)..
As you can see by the picture, there are three columns (E, F, G) which contain the source data. (source ID, target ID and Connection ID).. essentially there can only be one combination of source to target relationships, so I will need to merge any duplicate connections.
so far I have managed to find when they are duplicates by:
concatenating the source and target (Col H)
looking for duplicates (and ordering them) using the formula
=IF(COUNTIF(H:H,H2)>1,COUNTIF(H$2:H2,H2),1)
and Now I am trying to build a string which will be used to merge the records.
Essentially I am trying to build a function which looks for all exact strings in Col H, and then looks at the sequence(I) and builds a string like so:
34~62~65 (which tells me that connection 34 must merge with 62 and then 65)
Problem is that I have not managed to do this.
current formula in Col J is:
=IF(H2=H3,IF(I3=I2+1,G3&"~"&G2,""))
but as you can see its only pairwise, not actually looking for the duplicates in sequence (i.e. 1 then 2 then 3 etc)
A while ago I wrote a quite an extensive UDF for a friend of mine to deal with this problem. It is supposed to look exactly like a VLookup, except for an additional parameter UniqueOnly and a Separator.
What it does is it looks up a value based on a different cell just like VLookup, but unlike Vlookup it returns all possible values as a result, not just one.
It is used like this:
=LookupConcatenate(LookupValue,LookupRange,LookupColumn, [Optional UniqueOnly = 0], [Optional Separator = ", "])
And the code is:
Public Function LookupConcatenate(LookupValue As Range, LookupRange As Range, Column As Integer, Optional UniqueOnly As Boolean = False, Optional Separator As String = ", ") As String
' by Marek Stejskal
Dim rngMatch As Range
Dim rngLookup As Range
Dim varMatch As Variant
Dim varIndex As Variant
Dim intFoundAll As Integer
Dim strFoundAll() As String
Dim intFoundUnique As Integer
Dim strFoundUnique() As String
Dim blnFound As Boolean
Dim strResult As String
Dim i As Integer
On Error GoTo ErrHandler:
Set rngLookup = LookupRange
Set rngMatch = rngLookup.Columns(1)
Do While 1 = 1
' Match function
varMatch = Application.Match(LookupValue, rngMatch, 0)
' Exit checking if MATCH returned no value
If IsError(varMatch) Then Exit Do
' Index function
varIndex = Application.Index(rngLookup, varMatch, Column)
intFoundAll = intFoundAll + 1
' Adding space to ALL array
ReDim Preserve strFoundAll(1 To intFoundAll)
' Checking if the new result is in ALL array
blnFound = False
For i = 1 To UBound(strFoundAll)
If strFoundAll(i) = CStr(varIndex) Then
blnFound = True
Exit For
End If
Next
' If new result is unique add it to UNIQUE array
If blnFound = False Then
intFoundUnique = intFoundUnique + 1
ReDim Preserve strFoundUnique(1 To intFoundUnique)
strFoundUnique(intFoundUnique) = CStr(varIndex)
End If
' Add the new result to ALL array
strFoundAll(intFoundAll) = CStr(varIndex)
' Shortening ranges
Set rngLookup = rngLookup.Resize(rngLookup.Rows.Count - varMatch).Offset(varMatch)
Set rngMatch = rngLookup.Columns(1)
Loop
' Creating result string
If UniqueOnly = True Then
If intFoundUnique = 0 Then
strResult = ""
Else
For i = 1 To UBound(strFoundUnique)
strResult = strResult & IIf(strResult = "", "", Separator) & strFoundUnique(i)
Next i
End If
Else
If intFoundAll = 0 Then
strResult = ""
Else
For i = 1 To UBound(strFoundAll)
strResult = strResult & IIf(strResult = "", "", Separator) & strFoundAll(i)
Next i
End If
End If
LookupConcatenate = strResult
Exit Function
ErrHandler:
LookupConcatenate = Err.Description
End Function
To make this work for you, you will first need to switch the order of Connection and ID and then you can put on row 2 the formula like this:
=LookupConcatenate(G2, G2:J100, 2, 0, "~")
So if you want to do this without VBA, the only way is to build the string as you go down each row. What I mean is the final data would look like:
This does not meet the full requirements of all of column "F" containing the full concatenated string. But the last unique row of ID would contain the final string.
The formula to put in column F (assuming your data is aligned as in the picture here)
=IF(ISERROR(MATCH($D2,INDIRECT("D1:D"&ROW()-1),0)),""&$C2,IFERROR(INDEX(F:F,MATCH($D2,INDIRECT("D1:D"&ROW()-1),1)),INDEX(F:F,MATCH($D2,INDIRECT("D1:D"&ROW()-1),0)))&"~"&$C2)
This works even if the rows are not sorted, (and it actually does not use the sequence column at all). Here is a picture with additional rows added as test data:
You actually then could create the column you are searching for, by adding a column containing:
=IF(COUNTIF($F:$F,SUBSTITUTE($F2,"~","*")&"*")=1,$F2,FALSE)
That would give the following final result:

Excel VBA Convert Cell Name to It's Coordinates

Let's say I have this string which represents a cell: A2.
What should I do to covert it to coordinates: (2, 1) ?
Without VBA
Suppose, cell C2 contains string "A2".
Then
=INDIRECT(C2) returns reference to A2
=ROW(INDIRECT(C2)) returns row number - 2
=COLUMN(INDIRECT(C2)) returns column number - 1
="(" & ROW(INDIRECT(C2)) & "; " & COLUMN(INDIRECT(C2)) & ")" returns coordinates in format (x; y) - (2; 1)
UPD:
If you're using UDF, change your parameter type from String to Range:
Function GetData(Cell As Range)
MsgBox "My row is " & Cell.Row
MsgBox "My column is " & Cell.Column
End Function
if you call this UDF from worksheet like this: =GetData(A2), msg box would pop-up:
"My row is 2"
"My column is 1"
You can use Column and Row properties of the Range object:
Range("A2").Row
Range("A2").Column
Examlpe:
Sub test()
Dim x As String
x = "A2"
MsgBox GetRow(x) & " " & GetColumn(x)
End Sub
Function GetRow(Cell As String)
GetRow = Range(Cell).Row
End Function
Function GetColumn(Cell As String)
GetColumn = Range(Cell).Column
End Function

excel vlookup with multiple results

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.

Resources