Open Office Spreadsheet (Calc) - Concatenate text cells with delimiters - openoffice.org

I am using Open Office's spreadsheet program and am trying to concatenate several text cells together with delimeters. For example, suppose I have the cells below:
+--------+
| cell 1 |
+--------+
| cell 2 |
+--------+
| cell 3 |
+--------+
| cell 4 |
+--------+
| cell 5 |
+--------+
I would like to concatenate them with delimiters so that the result is in one cell like this one:
+----------------------------------------------+
| (cell 1),(cell 2),(cell 3),(cell 4),(cell 5) |
+----------------------------------------------+
My first thought was to try and make a macro or something, but I don't think open office supports those. Any ideas?

Thanks a lot Markus for finding a solution to this.
Here are some slightly more detailed instructions for the benefit of OpenOffice Basic newbies like myself. This applies to version 3.1:
Tools -> Macros -> Organize Macros -> OpenOffice.org Basic...
Now select from the explorer tree where you want your function live,
e.g. it can be in your own macro library (My Macros / Standard) or
stored directly in the current spreadsheet.
Now enter a new Macro name and click New to open the OO.org Basic IDE. You'll see a REM
statement and some stub Sub definitions. Delete all that and replace
it with:
Function STRJOIN(range, Optional delimiter As String, Optional before As String, Optional after As String)
Dim row, col As Integer
Dim result, cell As String
result = ""
If IsMissing(delimiter) Then
delimiter = ","
End If
If IsMissing(before) Then
before = ""
End If
If IsMissing(after) Then
after = ""
End If
If NOT IsMissing(range) Then
If NOT IsArray(range) Then
result = before & range & after
Else
For row = LBound(range, 1) To UBound(range, 1)
For col = LBound(range, 2) To UBound(range, 2)
cell = range(row, col)
If cell <> 0 AND Len(Trim(cell)) <> 0 Then
If result <> "" Then
result = result & delimiter
End If
result = result & before & range(row, col) & after
End If
Next
Next
End If
End If
STRJOIN = result
End Function
The above code has some slight improvements from Markus' original:
Doesn't start with a delimiter when the first cell in the range is empty.
Allows optional choice of the delimiter (defaults to ","), and the
strings which go before and after each non-blank entry in the range
(default to "").
I renamed it STRJOIN since "join" is the typical name of this
function in several popular languages, such as Perl, Python, and Ruby.
Variables all lowercase
Now save the macro, go to the cell where you want the join to appear,
and type:
=STRJOIN(C3:C50)
replacing C3:C50 with the range of strings you want to join.
To customise the delimiter, instead use something like:
=STRJOIN(C3:C50; " / ")
If you wanted to join a bunch of email addresses, you could use:
=STRJOIN(C3:C50; ", "; "<"; ">")
and the result would be something like
<foo#bar.com>, <baz#qux.org>, <another#email.address>, <and#so.on>

Well, after a lot more searching and experimenting, I found you can make your own functions in calc. This is a function I made that does what I want:
Function STRCONCAT(range)
Dim Row, Col As Integer
Dim Result As String
Dim Temp As String
Result = ""
Temp = ""
If NOT IsMissing(range) Then
If NOT IsArray(range) Then
Result = "(" & range & ")"
Else
For Row = LBound(range, 1) To UBound(range, 1)
For Col = LBound(range, 2) To UBound(range, 2)
Temp = range(Row, Col)
Temp = Trim(Temp)
If range(Row, Col) <> 0 AND Len(Temp) <> 0 Then
If(NOT (Row = 1 AND Col = 1)) Then Result = Result & ", "
Result = Result & "(" & range(Row, Col) & ") "
End If
Next
Next
End If
End If
STRCONCAT = Result
End Function

Ever so often I'd enjoy the ease and quickness of replace & calculation Options as well as in general the quick handling & modifying Options, when once again sitting in front of a dumped-file-lists or whatsoever.
I never understood why they didn't include such an essential function right from the start, really.
It's based on Adam's script, but with the extension to swap CONCAT from horizontal to vertical, while still keeping the delimiters in order.
Function CONCAT2D(Optional range, Optional delx As String, Optional dely As String, _
Optional xcell As String, Optional cellx As String, _
Optional swop As Integer)
Dim xy(1), xyi(1), s(1) As Integer
Dim out, cell, del, dxy(1) As String
'ReDim range(2, 1) 'Gen.RandomMatrix 4 Debugging
'For i = LBound(range, 1) To UBound(range, 1)
' For j = LBound(range, 2) To UBound(range, 2)
' Randomize
' range(i,j) = Int((100 * Rnd) )
' Next
'Next
out = ""
If IsMissing(delx) Then : delx = "," : End If
If IsMissing(dely) Then : dely = delx() : End If
If IsMissing(xcell) Then : xcell = "" : End If
If IsMissing(cellx) Then : cellx = xcell() : End If
If IsMissing(swop) Then : swop = 0 : End If
dxy(0) = delx() : dxy(1) = dely()
xyi(0) = 1 : xyi(1) = 2
If swop = 0 Then : s(0) = 0 : s(1) = 1
Else s(0) = 1 : s(1) = 0 : End If
If NOT IsMissing(range) Then
If NOT IsArray(range) _
Then : out = xcell & range & cellx
Else del = delx
For xy(s(0)) = LBound(range, xyi(s(0))) To UBound(range, xyi(s(0))
For xy(s(1)) = LBound(range, xyi(s(1))) To UBound(range, xyi(s(1))
cell = range(xy(0), xy(1))
If cell <> 0 AND Len(Trim(cell)) <> 0 _
Then : If out <> "" Then : out = out & del : End If
out = out & xcell & cell & cellx
del = dxy(s(0))
End If
Next : del = dxy(s(1))
Next
End If
Else out = "ERR"
End If
CONCAT2D = out
End Function

Related

How to replace spaces between words with another word?

I have a cell G which stores random words like "Hello, How are you"
I want to replace all the spaces with %20 to make it
"Hello%20,%20How%20%are%20you"
How can i replace spaces with %20?
Thanks
try like this:
=SUBSTITUTE(G1; " "; "%20")
Select the cells you wish to change and run this:
Sub SpaceChanger()
Dim rng As Range, r As Range
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
For Each r In rng
If r.Value <> "" Then
If InStr(r.Value, " ") <> 0 Then
r.Value = Replace(r.Value, " ", "%20")
End If
End If
Next r
End Sub
(using a macro will allow you to change the values "in place")

Find all occurences of exact string in range and list it

I want to create list of all occurences of "x" string in range. This is my sheet:
And I want to search all occurences and list them and give proper names:
For example for G2, I want "Beret Grey" string as result. I think that I need to use array formula or something like that.
Let me first preface this that vba would be much more robust, but this formula will get you there. It may be slow as it is an array type formula and is doing a lot of calculations. These calculations only expound exponentially as the number of cells with them in it increases:
=IFERROR(INDEX(A:A,AGGREGATE(15,6,ROW($B$2:$G$7)/($B$2:$G$7="x"),ROW(1:1))) & " " & INDEX($1:$1,AGGREGATE(15,6,COLUMN(INDEX(A:G,AGGREGATE(15,6,ROW($B$2:$G$7)/($B$2:$G$7="x"),ROW(1:1)),0))/(INDEX(A:G,AGGREGATE(15,6,ROW($B$2:$G$7)/($B$2:$G$7="x"),ROW(1:1)),0)="x"),ROW(1:1)-COUNTIF($B$1:INDEX(G:G,AGGREGATE(15,6,ROW($B$2:$G$7)/($B$2:$G$7="x"),ROW(1:1)) -1),"x"))),"")
You will need to expand the range to what you need. Change all the $B$2:$G$7 to $B$2:$N$29. Do not use full column references outside those that I have used. It will kill Excel.
Also note what is and what is not relative references, they need to remain the same or you will get errors as the formula is dragged/copied down.
As simple UDF to do what you want:
Function findMatch(rng As Range, crit As String, inst As Long) As String
Dim rngArr() As Variant
rngArr = rng.Value
Dim i&, j&, k&
k = 0
If k > Application.WorksheetFunction.CountIf(rng, crit) Then
findMatch = ""
Exit Function
End If
For i = LBound(rngArr, 1) + 1 To UBound(rngArr, 1)
For j = LBound(rngArr, 2) + 1 To UBound(rngArr, 2)
If rngArr(i, j) = crit Then
k = k + 1
If k = inst Then
findMatch = rngArr(i, 1) & " " & rngArr(1, j)
Exit Function
End If
End If
Next j
Next i
then you would call it like this:
=findMatch($A$1:$G$7,"x",ROW(1:1))
And drag/copy down.

Concatenate dynamic text values based on criteria in excel

I have a worksheet were I am trying to concatenate dynamic text values based on =TODAY()
So I have B3:B1000 being the fields where users will enter in text. D3:D1000 is where the user enters the date they filled it in. I3 is =TODAY()
How do I concatenate text values in B3:B1000 based on if the dates in the D3:D1000 = I3? and have that concatenation always update based on I3?
I would also need a delimiter of ", "
Got it working after some trail and error and some deeper searching :)
Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, _
ConcatenateRange As Range, Optional Separator As String = ",") As Variant
Dim i As Long
Dim strResult As String
On Error GoTo ErrHandler
If CriteriaRange.Count <> ConcatenateRange.Count Then
ConcatenateIf = CVErr(xlErrRef)
Exit Function
End If
For i = 1 To CriteriaRange.Count
If CriteriaRange.Cells(i).Value = Condition Then
strResult = strResult & Separator & ConcatenateRange.Cells(i).Value
End If
Next i
If strResult <> "" Then
strResult = Mid(strResult, Len(Separator) + 1)
End If
ConcatenateIf = strResult
Exit Function
ErrHandler:
ConcatenateIf = CVErr(xlErrValue)
End Function
and then used this concatenate function =ConcatenateIf(D3:D1000,I3,B3:B1000,", ")

How to read quoted field from CSV using VBScript

In a sample.csv file, which has fixed number of columns, I have to extract a particular field value and store it in a variable using VBScript.
sample.csv
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2345"
101,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2346"
I want to parse the last two fields which are within double quotes and store them in two different array variables for each row.
You could try using an ADO connection
Option Explicit
dim ado: set ado = CreateObject("ADODB.Connection")
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\txtFilesFolder\;Extended Properties=""text;HDR=No;FMT=Delimited"";"
ado.open
dim recordSet: set recordSet = ado.Execute("SELECT * FROM [samples.csv]")
dim field3, field4
do until recordSet.EOF
field3 = recordSet.Fields(3).Value
field4 = recordSet.Fields(4).Value
' use your fields here
recordSet.MoveNext
loop
recordSet.close
ado.close
You may have an issue if those fields are greater than 255 characters in length - if they are, they may return truncated. You also may have better luck with ODBC or ACE connection strings instead of the Jet one I've used here.
Since CSV's are comma-separated, you can use the Split() function to separate the fields into an array:
' Read a line from the CSV...
strLine = myCSV.ReadLine()
' Split by comma into an array...
a = Split(strLine, ",")
Since you have a static number of columns (5), the last field will always be a(4) and the second-to-last field will be a(3).
Your CSV data seems to contain 2 embedded hard returns (CR, LF) per line. Then the first line ReadLine returns is:
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
The solution below unwraps these lines before extracting the required fields.
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Line, LineNo, Fields, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Line = ""
LineNo = 0
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Do While Not TextStream.AtEndOfStream
Line = Line & TextStream.ReadLine()
LineNo = LineNo + 1
If LineNo mod 3 = 0 Then
Fields = Split(Line, ",")
Field4 = Fields(3)
Field5 = Fields(4)
MsgBox "Line " & LineNo / 3 & ": " & vbNewLine & vbNewLine _
& "Field4: " & Field4 & vbNewLine & vbNewLine _
& "Field5: " & Field5
Line = ""
End If
Loop
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub
Here is an alternative solution that allows for single or multiline CSV records. It uses a regular expression which simplifies the logic for handling multiline records. This solution does not remove CRLF characters embedded in a record; I've left that as an exercise for you :)
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Text, MyRegExp, MyMatches, MyMatch, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Set MyRegExp = New RegExp
MyRegExp.Multiline = True
MyRegExp.Global = True
MyRegExp.Pattern = """([^""]+)"",""([^""]+)"""
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Text = TextStream.ReadAll
Set MyMatches = MyRegExp.Execute(Text)
For Each MyMatch in MyMatches
Field4 = SubMatches(0)
Field5 = SubMatches(1)
MsgBox "Field4: " & vbNewLine & Field4 & vbNewLine & vbNewLine _
& "Field5: " & vbNewLine & Field5, 0, "Found Match"
Next
Set MyMatches = Nothing
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub

VBA parsing of numeric ranges from string

I need to parse numeric range from User Form (VBA, Excel).
For example: {1-3,5,9} -> {1,2,3,5,9,}
The question has already been discussed here:
Advanced parsing of numeric ranges from string
The task is quite standart, is there any ready-made solution for VBA?
I am assuming that the encompassing braces are not part of the string. Consider the following UDF:
Public Function DashFiller(sIn As String) As String
Dim N As Long, NN As Long
DashFiller = ""
ary = Split(sIn, ",")
For N = LBound(ary) To UBound(ary)
If InStr(1, ary(N), "-") > 0 Then
ary2 = Split(ary(N), "-")
ary(N) = ary2(0)
For NN = ary2(0) + 1 To ary2(1)
ary(N) = ary(N) & "," & NN
Next NN
End If
Next N
DashFiller = Join(ary, ",")
End Function
So if A1 contains:
1-2,3,4,5,9-12
and B1 contains:
=DashFiller(A1)
then B1 would display:
1,2,3,4,5,9,10,11,12

Resources