I have a file with a bunch of numbers in columns. These numbers are separated by a variable number of spaces. I want to skip the first line and get all the other lines and separate each number on the line. Finally, I want to write each number in Excel. I've been able to get the lines and write them on Excel but I can't separate each number (I'm getting the whole line as one string).
Does any body know how to split a string that has a variable number of spaces?
Here is my code.
Sub Test()
r = 0
With New Scripting.FileSystemObject
With .OpenTextFile("C:\Users\User\Desktop\File.tab", ForReading)
If Not .AtEndOfStream Then .SkipLine
Do Until .AtEndOfStream
ActiveCell.Offset(r, 0) = Split(.ReadLine, vbCrLf)
r = r + 1
Loop
End With
End With
End Sub
If you use the Excel worksheet function trim in place of the VBA function then excel will remove multiple spaces within a cell (not just from the left and right ends). Something like the below should solve the problem. I'm afraid I've not tested it as I haven't a copy of Excel handy.
Sub Test()
Dim splitValues As Variant
Dim i As Long
r = 0
With New Scripting.FileSystemObject
With .OpenTextFile("C:\Users\User\Desktop\File.tab", ForReading)
If Not .AtEndOfStream Then .SkipLine
Do Until .AtEndOfStream
ActiveCell.Offset(r, 0) = Split(.ReadLine, vbCrLf)
Application.Trim(ActiveCell.Offset(r, 0))
splitValues = Split(ActiveCell.Offset(r, 0), " ")
For i = 0 To UBound(x)
ActiveCell.Offset(r, i+1) = splitValues(i)
Next
Loop
r = r + 1
End With
End With
Related
I'm currently busy with Excel tooling and learning a lot but i got a question. Currently i have a couple rows with data in the rows. In the rows there is a lot of data but i need a specific part of the row. Of course i can delete it all manually but to do that for 3000 rows i will be wasting a lot of time.
Can any one help me with a macro that filters data. The data i need is between [ and ] so for example [data]
I hope you guys can help me out and if you need more information just ask me! I hope you guys can help me!
Example String ROW:
[Sandwitch]><xsd:element name="T8436283"
So what do i need?
So i need a macro that only gets the Sandwitch out of it and paste it in the B column. The string with all the information stays at column A and the Sandwitch goes to Column B and that for all rows.
Option 1: Find/Replace
1) Copy data in another column (just saving original copy)
2) Perform Find/Replace "*["
3) Perform Find/Replace "]"
Now you have data which was between [].
Option 2: Use formulas
1) Lets assume that original data in Column "A"
2) Apply this formula in column "B" which will extract data between []
=MID(A1,FIND("[",A1)+1,FIND("]",A1)-FIND("[",A1)-1)
Option 3: Macro
If it is absolutely needed, I can help create a macro, otherwise try first two easier options.
A general purpose "find element in s starting x up to next y":
Function GenExtract(FromStr As String, _
StartSep As String, EndSep As String) _
As Variant
Dim StPos As Long
Dim EnPos As Long
GenExtract = CVErr(xlErrNA)
If StartSep = "" Or EndSep = "" Then Exit Function 'fail
StPos = InStr(1, FromStr, Left(StartSep, 1))
If StPos = 0 Or StPos = Len(FromStr) Then Exit Function 'fail
EnPos = InStr(StPos + 1, FromStr, Left(EndSep, 1))
If EnPos = 0 Then Exit Function 'fail
GenExtract = Mid(FromStr, StPos + 1, EnPos - StPos - 1)
End Function
If the two separators are the same, as per quotes, it gives the first string enclosed by those.
If you want to get your feet wet in Regular Expressions, the following code will take you there. You have to add a reference to the VB Scripting Library
Tools > References > Microsoft VBScript Regular Expressions 5.5
Then the code is as follows:
Sub textBetweenStuffs()
Dim str As String
Dim regEx As RegExp
Dim m As Match
Dim sHolder As MatchCollection
Dim bracketCollection As Collection
Dim quoteCollection As Collection
Set regEx = New RegExp
'Matches anything in between an opening bracket and first closing bracket
regEx.Pattern = "\[(.*?\])"
str = "[Sandwitch]><xsd:element name=""T8436283"""
'populates matches into match collection
Set sHolder = regEx.Execute(str)
Set bracketCollection = New Collection
'loop through values in match collection to do with as you wish
For Each m In sHolder
bracketCollection.Add m.Value
Next i
Set sHolder = Nothing
'get values between Quotations
regEx.Pattern = "\"(.*?\")"
'populates matches into match collection
Set sHolder = regEx.Execute(str)
Set quoteCollection = New Collection
'loop through values in match collection to do with as you wish
For Each m In sHolder
quoteCollection.Add m.Value
Next i
End Sub
I am trying to sum all the out(OUT) times from a csv string and show it in the next cell but is facing challenges. I am not able to process/split csv string. Need help on how to achieve this by excel formula or vba script.
csv string:
10:06:in(IN),11:36:out(OUT),11:42:in(IN),13:57:out(OUT),14:05:in(IN),14:23:out(OUT),14:38:in(IN),16:39:out(OUT),16:49:in(IN),17:19:out(OUT),17:28:in(IN),17:54:out(OUT),17:56:in(IN),18:08:in(IN),18:08:out(OUT),18:11:in(IN),18:12:out(OUT),18:21:out(OUT),18:24:in(IN),18:37:in(IN),18:37:out(OUT),18:57:out(OUT),18:58:in(IN),19:26:out(OUT),19:35:in(IN),20:18:out(OUT),
The string is from one cell.
Consider the following UDF:
Public Function SumOutTimes(rin As Range) As Date
Dim Kount As Long, OutTimes(), t As String
t = rin.Text
ary = Split(t, ",")
Kount = 1
For Each a In ary
If InStr(1, a, "out") > 0 Then
ReDim Preserve OutTimes(1 To Kount)
OutTimes(Kount) = Replace(a, ":out(OUT)", "")
Kount = Kount + 1
End If
Next a
For Each a In OutTimes
SumOutTimes = SumOutTimes + TimeValue(a)
Next a
End Function
For your data in cell A1
EDIT#1:
User Defined Functions (UDFs) are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the UDF will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the UDF:
bring up the VBE window as above
clear the code out
close the VBE window
To use the UDF from Excel:
=SumOutTimes(A1)
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
and for specifics on UDFs, see:
http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
Macros must be enabled for this to work!
This may help you :
Sub test()
Dim Tx As String, A() As String, R()
Tx = Sheets("test").Cells(1, 1)
ReDim R(0)
A = Split(Tx, ",")
For i = LBound(A) To UBound(A)
If Left(Right(A(i), 4), 2) <> "OU" Then
'IN times
Else
'OUT times
R(UBound(R)) = Left(A(i), 5)
ReDim Preserve R(UBound(R) + 1)
End If
Next i
ReDim Preserve R(UBound(R) - 1)
For i = LBound(R) To UBound(R)
'---------------------------------------
'------You can sum your times here------
'---------------------------------------
Next i
End Sub
You juste have to read the CSV string and put it into Tx variable and choose how to sum your times!
So I have data in format :
data1|data2|data3|data4|data5|data6|... etc.
I want Word to put enter (break line) after every 5th occurence of | in order to structure and separate data.
I cant find a simple and quick way to doing that. Any ideas?
Use the built-in Split function and rebuild the data string using the vbCrLf constant to add the line-feed.
Note that the Split function removes the delimiter, so if you need it in the output, you have to add it back when you add the strings in the For loop.
Something like the following could work:
Option Explicit
Sub GroupDataStringByFive()
Dim sIn As String
Dim sOut As String
Dim sArr() As String
Dim iForCounter As Integer
sIn = "data1|data2|data3|data4|data5|data6"
sArr = Split(sIn, "|")
If IsArray(sArr) Then
For iForCounter = 0 To UBound(sArr)
If iForCounter > 0 And iForCounter Mod 5 = 0 Then
sOut = sOut & vbCrLf & sArr(iForCounter)
Else
sOut = sOut & sArr(iForCounter)
End If
Next iForCounter
End If
MsgBox sOut
End Sub
I'm using the code below to separate a group of strings separated by a comma (,), then saves the output in a string variable named, msg. Strings in variable msg is separated by vbNewLine.
For example:
Original string for example is fruits, contains: apple, mango, orange
after applying the function splittext(fruits)
the variable now msg contains: apple <vbNewLine> mango <vbNewLine> orange
Now, I wanted to separate the content of this msg to cell(each string).
For example, mango is in A1, apple is in A2, orange is in A3 (on a different sheet.
I tried 'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i), (see the code below). But it's not working. After the execution, the cells in the sheet2 remains unchanged. I really need your help. Thanks.
Function splittext(input_string As String) As String
Dim SptTxt As String
Dim Cs As Variant
Dim CsL As Byte
Dim CsU As Byte
Dim i As Byte
Dim col As Collection
Set col = New Collection
Cs = Split(input_string, ",")
CsL = LBound(Cs)
CsU = UBound(Cs)
Dim msg As String
For i = CsL To CsU
ReDim arr(1 To CsU)
col.Add Cs(i)
msg = msg & Cs(i) & vbNewLine
'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i)
Next
splittext = msg
End Function
Here's your macro refactored to give the results you describe, without any looping.
Function splittext(input_string As String) As String
Dim Cs As Variant
Cs = Split(input_string, ",")
splittext = Join(Cs, vbNewLine)
' Put results into workbook
With ActiveWorkbook.Sheets("Sheet2")
Range(.[A1], .Cells(UBound(Cs) + 1, 1)).Value = Application.Transpose(Cs)
End With
End Function
Note that copying an array to a range requires a 2 dimensional array, rows x columns. Transpose is a handy function to convert a 1 dim array to a 2 dim array
EDIT
Note that if you call this as a user-defined function (UDF) from a cell (as you are in the sample file) it will fail (If it is called from a VBA Sub it will work). This is because a UDF cannot modify anything in Excel, it can only return to the calling cell (there is a rather complex workaround, see this answer.) If you remove the With section it does work as a UDF.
If what you are trying to return the list into multiple cells, consider using an array function.
You have to use it like that:
ActiveWorkbook.Sheets("Sheet2").Range("A" & i+1).Value = Cs(i)
You try to write in the Cell "A0" because "i" is in the First loop zero. And this is not working because there is no cell "A0".
And you had an "s" by ActiveWorkbook.
Moosli
I'm looking for the best way of loading formatted data in VBA. I’ve spent quite some time trying to find the equivalent of C-like or Fortran-like fscanf type functions, but without success.
Basically I want to read from a text file millions of numbers placed on many (100,000’s) lines with 10 numbers each (except the last line, possibly 1-10 numbers). The numbers are separated by spaces, but I don’t know in advance the width of each field (and this width changes between data blocks).
e.g.
397143.1 396743.1 396343.1 395943.1 395543.1 395143.1 394743.1 394343.1 393943.1 393543.1
-0.11 -0.10 -0.10 -0.10 -0.10 -0.09 -0.09 -0.09 -0.09 -0.09
0.171 0.165 0.164 0.162 0.158 0.154 0.151 0.145 0.157 0.209
Previously I’ve used the Mid function but in this case I can’t, because I don’t know in advance the width of each field. Also it's too many lines to load in an Excel sheet. I can think of a brute force way in which I look at each successive character and determine whether it’s a space or a number, but it seems terribly clumsy.
I’m also interested in pointers on how to write formatted data, but this seems easier -- just format each string and concatenate them using &.
The following snippet will read whitespace-delimited numbers from a text file:
Dim someNumber As Double
Open "YourDataFile.txt" For Input As #1
Do While Not (EOF(1))
Input #1, someNumber
`// do something with someNumber here...`
Loop
Close #1
update: Here is how you could read one line at a time, with a variable number of items on each line:
Dim someNumber As Double
Dim startPosition As Long
Dim endPosition As Long
Dim temp As String
Open "YourDataFile" For Input As #1
Do While Not (EOF(1))
startPosition = Seek(1) '// capture the current file position'
Line Input #1, temp '// read an entire line'
endPosition = Seek(1) '// determine the end-of-line file position'
Seek 1, startPosition '// jump back to the beginning of the line'
'// read numbers from the file until the end of the current line'
Do While Not (EOF(1)) And (Seek(1) < endPosition)
Input #1, someNumber
'// do something with someNumber here...'
Loop
Loop
Close #1
You could also use regular expressions to replace multiple whitespaces to one space and then use the Split function for each line like the example code shows below.
After 65000 rows have been processed a new sheet will be added to the Excel workbook so the source file can be bigger than the max number of rows in Excel.
Dim rx As RegExp
Sub Start()
Dim fso As FileSystemObject
Dim stream As TextStream
Dim originalLine As String
Dim formattedLine As String
Dim rowNr As Long
Dim sht As Worksheet
Dim shtCount As Long
Const maxRows As Long = 65000
Set fso = New FileSystemObject
Set stream = fso.OpenTextFile("c:\data.txt", ForReading)
rowNr = 1
shtCount = 1
Set sht = Worksheets.Add
sht.Name = shtCount
Do While Not stream.AtEndOfStream
originalLine = stream.ReadLine
formattedLine = ReformatLine(originalLine)
If formattedLine <> "" Then
WriteValues formattedLine, rowNr, sht
rowNr = rowNr + 1
If rowNr > maxRows Then
rowNr = 1
shtCount = shtCount + 1
Set sht = Worksheets.Add
sht.Name = shtCount
End If
End If
Loop
End Sub
Function ReformatLine(line As String) As String
Set rx = New RegExp
With rx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "[\s]+"
ReformatLine = .Replace(line, " ")
End With
End Function
Function WriteValues(formattedLine As String, rowNr As Long, sht As Worksheet)
Dim colNr As Long
colNr = 1
stringArray = Split(formattedLine, " ")
For Each stringItem In stringArray
sht.Cells(rowNr, colNr) = stringItem
colNr = colNr + 1
Next
End Function