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,", ")
Related
I'm trying to write an inputted date from the adjacent cell.
i.e. date entered in A1, B1 = A1 but in word form (in Spanish).
I'm close to a solution but I'm sure making things more complicated than they need to be.
The date column(A) is currently being separated into 3;
day(B), month(D), year(F), using; =LEFT($A1;2), =MID($A1;4;2), =RIGHT($A1;4) accordingly.
In Columns C,E,G I'm using
=INDEX(IMPORTXML("https://www.buscapalabra.com/numeros-a-letras.html?cifra="&B1;"//li[1]//strong");1)
where B1 changes to E1, F1 depending on the column
finally in column H where the date will be written I use:
=trim(LOwer($C2&"de "&TEXT($D2;"mmmm")&" de "&$F2))&If(Value(Right($E2;1))=1;If(Value(MID($E2;4;1))<>1;"o";"");"")
For some reason the text value returned from the site has a space on the end and also does not properly word numbers ending in 1. Hence the use of TRIM() & the nested IF()
It works for now, I haven't tested it exhaustedly but I'd love to hear what people think, I'm new to Sheets but there has to be a cleaner way to do this.
Use custom functions:
You could do this with an Apps Script Custom Function.
First, open a bound script by selecting Tools > Script editor, and copy the following functions to the script (check inline comments for more information):
function DATE_IN_WORDS(date) {
const day = date.getDate(); // Day of the month in numbers
const year = date.getFullYear(); // Year in numbers
const options = { month: 'long'};
const month = new Intl.DateTimeFormat('es-ES', options).format(date); // Month in words
const dayAndYear = [day, year].map(number => { // Retrieve word for day and year
const url = "https://www.buscapalabra.com/numeros-a-letras.html?cifra=" + number
const resp = UrlFetchApp.fetch(url).getContentText();
const first = "<em>Como sustantivo:</em> El <strong>";
const cut = resp.substring(resp.indexOf(first), resp.length);
let word = cut.substring(first.length, cut.indexOf("</strong>")); // Get desired section of HTML
if (number.toString().slice(-1) == "1" && number.toString().slice(-2) != "11") {
word = word.trim() + "o"; // Replace "un" with "uno"
let arrayWord = word.split(" ");
let lastWord = arrayWord.pop();
if (lastWord === "veintiúno") { // If 21, replace "ú" with "u"
lastWord = lastWord.replace("ú", "u");
arrayWord.push(lastWord);
word = arrayWord.join(" ");
}
return word;
} else return word;
});
return dayAndYear.join("de " + month + " de "); // Join day, month and year
}
This function uses:
Intl.DateTimeFormat to retrieve the month in Spanish.
UrlFetchApp to fetch information from https://www.buscapalabra.com/numeros-a-letras.html.
Once it is defined, you can use the function DATE_IN_WORDS the same you would any sheets built-in function. This function would accept the cell with the Date as a parameter.
Example:
Reference:
Custom Functions in Google Sheets
I have some code which reads in a tab delimited file where cell reference B2 matches the reference in the first column in the tab delimited file. This works fine where the text file is small. The below works on a sample file with aa bb and cc as the headers with dummy data.
Option Explicit
Sub TestImport()
Call ImportTextFile(Sheet1.Range("B1"), vbTab, Sheet2.Range("A4"))
End Sub
Public Sub ImportTextFile(strFileName As String, strSeparator As String, rngTgt As Range)
Dim lngTgtRow As Long
Dim lngTgtCol As Long
Dim varTemp As Variant
Dim strWholeLine As String
Dim intPos As Integer
Dim intNextPos As Integer
Dim intTgtColIndex As Integer
Dim wks As Worksheet
Set wks = rngTgt.Parent
intTgtColIndex = rngTgt.Column
lngTgtRow = rngTgt.Row
Open strFileName For Input Access Read As #1
While Not EOF(1)
Line Input #1, strWholeLine
varTemp = Split(strWholeLine, strSeparator)
If CStr(varTemp(0)) = CStr(Range("B2")) Then
wks.Cells(lngTgtRow, intTgtColIndex).Resize(, UBound(varTemp) + 1).Value = varTemp
lngTgtRow = lngTgtRow + 1
End If
Wend
Close #1
Set wks = Nothing
End Sub
I am trying to get the below bit of code to work using ADO as this will run much faster on a text file with a couple of million records however I am getting an error on the '.Open str' part of the code (no value given for one or more required parameters).
It looks like it is to do with how I am defining the string- could you review and see if there is something I am missing...?
Sub QueryTextFile()
t = Timer
Dim cnn As Object
Dim str As String
Set cnn = CreateObject("ADODB.Connection")
cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnn.ConnectionString = "Data Source=C:\Users\Davids Laptop\Documents\Other Ad Hoc\Test Files\;Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
cnn.Open
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
str = "SELECT * FROM [test1.txt] WHERE [aa]=" & Chr(34) & Range("B2") & Chr(34)
With rs
.ActiveConnection = cnn
.Open str
Sheet1.Range("A4").CopyFromRecordset rs
.Close
End With
cnn.Close
MsgBox Timer - t
End Sub
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
I often run into VALUE! errors in my calculations because they contain numbers and text. How can I leave the text in the cell and proceed with the calculation?
For example:
cell A1 contents look like this: 101.1 J
cell A2 contents look like this: 500 U
cell A3 contents look like this: 0.2
If I want to add A1+A2+A3 into cell A4, how can I ignore the J and U to calculate 101.1+500+0.2 to get 602.3 in cell A4?
Thanks!
You need extract the values from the strings - and this can only be done if you have some kind of information about the format to the numbers. In your example, you could place the following formula in B1:B3 and then add a =SUM(B1:B3):
=IF(ISNUMBER(A1),A1,VALUE(LEFT(A1,SEARCH(" ",A1)-1)))
The above formula will extract the number and convert it to a value - unless it was already a number.
Using Custom Function
Place below code in Standard Module
Function add_num(cell1, ParamArray Arr() As Variant)
Dim temp As Double
For i = LBound(Arr) To UBound(Arr)
temp = temp + GetNumber(Arr(i))
Next
add_num = GetNumber(cell1.Value) + temp
End Function
Function GetNumber(ByVal str As String) As Double
Dim objRegEx As Object
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Pattern = "\d{1,2}([\.,][\d{1,2}])?"
Set allMatches = objRegEx.Execute(str)
For i = 0 To allMatches.Count - 1
result = result & allMatches.Item(i)
Next
GetNumber = result
End Function
add_num function can be called from excel interface using =addnum(<cells>). It accepts multiple cells.
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