Let's say I have a series of cells like so:
A
1 Foo
2 Bar
3 Hello
4 World
5 Random Text
What I'd like to do is have the result of my formula populate another cell with:
Foo, Bar, Hello, World, Random Text
Now, I know how to concatenate two cells with:
=A1&", "&A2
but how can I do the same thing with the entire series?
Here's a function you might be able to use. Simply put this in your workbook code module, then you can enter it in cells like:
=JoinRange(A1:A6) or =JoinRange(A2:D15), etc.
Public Function JoinRange(ByVal rng As Range) As String
Dim dlmt As String: dlmt = ","
Dim multiRow As Boolean: multiRow = rng.Rows.Count > 1
Dim r As Long, c As Long
Select Case rng.Columns.Count
Case 1
If multiRow Then
JoinRange = Join(Application.WorksheetFunction.Transpose(rng), dlmt)
Else:
'a single cell
JoinRange = rng
End If
Case Is > 1
If multiRow Then
'a 2d range of cells:
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
JoinRange = JoinRange & rng(r, c) & dlmt
Next
Next
JoinRange = Left(JoinRange, Len(JoinRange) - 1)
Else:
JoinRange = Join(Application.WorksheetFunction.Transpose( _
Application.WorksheetFunction.Transpose(rng)), dlmt)
End If
Case Else
End Select
End Function
Put a comma and a space in cell B1, then use this formula:
=CONCATENATE(A1,B1,A2,B1,A3,B1,A4, B1, A5)
There are several answers to the following question that you can try as well, including VBA options and a formula:
Need to concatenate varying number of cells...
With =A1 in B1 then =B1&", "&A2 in B2 and copied down would seem to work.
Related
I'm trying to obtain a column that will contain the index number of first word from the referenced column cell by cell.
I am able to get the length of word in a text, for upper cell value in have used ActiveCell.Offset(-1, 0).Activate but it does not work for me.
Public Function StartIndex(ByVal strText As String) As Long
Application.Volatile
Length = UBound(Split(strText, " ")) + 1
StartIndex = ActiveCell.Offset(-1, 0).Activate + Length
End Function
look below, consider I'm having col1 by default and want startIndex through VBA;
Col1 | startIndex
VBA Index Printer Friendly version | 1
Adobe Acrobat version | 6
A UDF can remain in a code module | 9
as shown above consider the table have 3 rows and two columns,the index number of word "VBA"**in col1 row1 is 1 similarly word **"is" next to word "VBA" have an index of 2, and so on .. Consider the rows are a combination of a paragraph and so when we reach Col1 row2 the index of word "Adobe" should be 6 as shown in table
Actually startIndex column shows the index number of the first word from the paragraph which is divided in rows
No need for VBA just use a formula to count the words:
Then add the amount of words to the previous amount of words (from the row above).
Write 1 into B1 (it is always 1)
Use the following formula in B2:
=B1+LEN(TRIM(A1))-LEN(SUBSTITUTE(TRIM(A1)," ",""))+1
Copy the formula from B2 to B3
I've modified your original Function a litte bit, to be able to handle ranges:
Public Function StartIndex(ByVal vRNG As Range) As Long
Application.Volatile
Dim rng As Range
For Each rng In vRNG
StartIndex = UBound(Split(rng.Value, " ")) + 1 + StartIndex
Next rng
End Function
Then, you can apply it like this:
=StartIndex($A$1:A1)+1
But to make it work you need to apply it from row 2....
Another option would be to input in B1 just a 1 (because it always going to be 1) and then in B2, same formula:
=StartIndex($A$1:A1)+1
And it would work:
I'd approach this slightly differently and pass the range instead.
Public Function StartIndex(ByVal textCell As Range) As Long
Dim text As String
text = textCell.Value
Dim result As Long
result = (UBound(Split(text, " ")) + 1)
If textCell.Row > 1 Then
result = result - (UBound(Split(textCell.Offset(-1, 0).Value, " ")) + 1)
End If
StartIndex = result
End Function
example use:
=StartIndex(A1)
or in VBA:
Dim index As Long
index = StartIndex(Range("A1"))
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).
I want to change the following
123456789A1
to
123-456-789 A1
Background:
In Format Cells, I used this:
000-0000-00 00
And that works if everything in the cell is a number,
12345678911
will become
123-4567-89 11
But as soon there is a letter, it breaks it.
How can I change the type to ignore letters?
this is an example :
Sub test()
a = [A1]
b = Left(a, 3) & "-" & Mid(a, 4, 3) & "-" & Mid(a, 7, 3) & " " & Right(a, 2)
[A2] = b
End Sub
But want you 3 or 4 numbers in the seconde position?
if A1=123456789A1 then in A2 : 123-456-789 A1
Cell number formatting only works on numbers.
If you don't mind changing the values into text strings, you could format them in VBA using the Format function. For example:
Option Explicit
Sub FMT()
Dim R As Range, C As Range
Const sFMT As String = "###-####-## ##"
Set R = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each C In R
C.Value = Format(C.Text, sFMT)
Next C
End Sub
You will need to change the range arguments to match what you need. And you could also use this in an event-triggered macro to do it automatically.
I have a list of cells with values like the below:
a,a,b,c,d
f,g,h,h,h,j
a,b,b
f,f,f,y,y,u,u
I want a formula that will give me the below (unique list of above). I should be able to write it for one row and copy it down.
a,b,c,d
f,g,h,j
a,b
f,y,u
There is no way to do this with a formula that will return comma-separated unique results into one cell, using only the built-in worksheet functions.
But, it is very simple to achieve the same thing with a User Defined Function (UDF).
Just place this small routine in a standard code module:
Public Function UniqueList(s)
Dim i&, k$, v
v = Split(s, ",")
For i = 0 To UBound(v)
If InStr(k, v(i)) = 0 Then k = k & "," & v(i)
Next
UniqueList = Mid$(k, 2)
End Function
If your source string is in cell A1 then in cell B1 enter this formula:
=UniqueList(A1)
That's it. Now copy the formula downward as far as needed.
Considering the repeated letters are in order, as in your sample, this should do the trick:
Function UniqueLetters(ByVal cell As Range) As String
letters = Split(cell.Value, ",")
For Each letter In letters
If letter <> current_letter Then
current_letter = letter
unique_letters = unique_letters + letter + ","
End If
Next
UniqueLetters = Left(unique_letters, Len(unique_letters) - 1)
End Function
I have a simple table where I want to search column A for a value via A1:A10.
When it finds a value it should copy/paste it to the correspond ending cell in column B.
-Moreover it would be nice to search for multiple values like
"value1 value2 value3 and to copy all found values in A to B.
The output should be:
And for multiple values:
EDIT:
I had to replace the functions with german, but it won't work for me.
For B2 I added: =GLÄTTEN(VERKETTEN(D2;" ";E2;" ";F2;" ";G2))
For C2 I added: =GLÄTTEN(VERKETTEN(B2;" ";D2;" ";E2;" ";F2;" ";G2))
For C10 I added: =GLÄTTEN(LINKS(B10;FINDEN(" ";B10)))
For D10 I added: =GLÄTTEN(LINKS(B11;FINDEN(" ";B11)))
For E10 I added: =GLÄTTEN(LINKS(B12;FINDEN(" ";B12)))
For F10 I added: =GLÄTTEN(B13)
For B11 I added: =TEIL(B10;LÄNGE(C10)+2;99)
For B12 I added: =TEIL(B11;LÄNGE(D10)+2;99)
For B13 I added: =TEIL(B12;LÄNGE(E10)+2;99)
The translation I got from here.
You can do it efficiently in VBA as below
Hit Alt and F11 to open the Visual Basic Editor (VBE).
From the menu, choose Insert-Module.
copy and paste the code into the code window at right.
Hit Alt and F11 to return to Excel
run the macro from the Developer tab for Excel 2007 and higher, for Excel 2003 use ...Tools-Macro-Macros
enter code here
Sub QuickFInd()
Dim X As Variant
Dim Y As Variant
Dim vWords As Variant
Dim Vword As Variant
Dim lngCnt As Long
X = Range("A2:A8").Value2
ReDim Y(1 To UBound(X), 1 To 1)
vWords = Split([b10].Value)
For lngCnt = 1 To UBound(X)
For Each Vword In vWords
If InStr(X(lngCnt, 1), Vword) > 0 Then Y(lngCnt, 1) = Y(lngCnt, 1) & Vword & Chr(32)
Next Vword
Next
[b2].Resize(UBound(Y), 1).Value2 = Y
End Sub
I've solved your problem with VBA code. To use it, create a VBA module in the excel workbook and paste the following code in. Then go back to the worksheet you want it to run on, and click "Macros" and select "Search".
Let me know how it works ~
Example:
Code:
Public Sub search()
'Enter the location of your "Key Word" cell here (where you want the search values to come from)
Dim KeyCell As String: KeyCell = "B11"
'Enter the range you would like to search here
Dim searchRange As Range: Set searchRange = ActiveSheet.Range("A2", "A11")
'Enter the column you want to print to
Dim printColumn As String: printColumn = "B"
'##### the real program starts here ####
'create an array of values that we will search for
Dim values() As String
'each item in the values array is separated by a space in the "Key Word" cell
values = Split(CStr(ActiveSheet.Range(KeyCell).Value), " ")
Dim dataCell As Object
'now we loop through each cell in the search range
For Each dataCell In searchRange
'loop through each value in our array of values
For Each v In values
'check to see if our value is in the cell we are searching
If InStr(1, CStr(dataCell.Value), CStr(v), vbBinaryCompare) > 0 Then
'print
With ActiveSheet.Range(printColumn & dataCell.Row)
.Value = .Value & " " & CStr(v)
End With
End If
Next v
Next dataCell
End Sub
If you want only a search without PASTE or VBA, you can follow the scheme:
and add formula:
B2 -> =TRIM(CONCATENATE(D2;" ";E2;" ";F2;" ";G2))
C2 -> =IF(IFERROR(FIND(C$10;$A2)>0;"")=TRUE;C$10;"") and autocomplete
C10 -> =TRIM(LEFT(B10;IFERROR(FIND(" ";B10);99))) CORRECT !
D10 -> =TRIM(LEFT(B11;IFERROR(FIND(" ";B11);99))) CORRECT !
E10 -> =TRIM(LEFT(B12;IFERROR(FIND(" ";B12);99))) CORRECT !
F10 -> =TRIM(B13)
B11 -> =MID(B10;LEN(C10)+2;99)
B12 -> =MID(B11;LEN(D10)+2;99)
B13 -> =MID(B12;LEN(E10)+2;99)
Hiding the Support Formula Columns. You can add how many words you want... obviusly adding other formulas.
If you need to add phisically the values, you can add a column between A & B and copy and paste with value the moved column "C" (Ex B). Modify the C2 formula in:
=TRIM(CONCATENATE(B2;" ";D2;" ";E2;" ";F2;" ";G2)) and autocomplete...
This formulas add the keys already saved... (No duplicate check).
I have correct the formula... Previously work only with 4 key...
You could do something like this:
=IF(IFERROR(FIND($B$10,A2,1),0)>0,$B$10&" ","")&IF(IFERROR(FIND($B$11,A2,1),0)>0,$B$11&" ","")&IF(IFERROR(FIND($B$12,A2,1),0)>0,$B$12&" ","")
And just auto-fill that down for all your text items.