Serial comma delimited text - Import to XL evry 8th comma nuRow

[Billp]

Hi,
I have a print out of a weighing scale.
It has outputted in serial text - comma delimited.
Bag Weight, Month, Day, Year, Hours, Minutes, Seconds, extra comma then
repeats.
How can I import into xl such a text file so that every 8th comma denotes a
new row?
Example:
14.1230001,6,21,2009,19,46,51,,14.1230001,6,21,2009,19,46,53,,14.1230001,6,21,2009,19,46,54,,

Every 8th coma denotes a new row.

Help.
Regards
Bill

 

[KC]

Sequential read, counting commas I think.

 

[Billp]

Hi KC,

Thanks for the reply.
Could you point me in the direction of an example please.
Thanks
Bill

 

[Dave Peterson]

I _think_ that this does what you want.

But it dumps each of the "records" into column A.

After you've verified that it's working ok, you could record a macro when you
did the data|text to columns (specifying each of your fields the way you need)
and include it in the macro (or run that separately if you want).

Option Explicit
Sub testme01()

Dim TextLine As String
Dim lCtr As Long
Dim CommaCtr As Long
Dim MaxCommasPerRec As Long
Dim StartPos As Long
Dim myStr As String
Dim oRow As Long
Dim wks As Worksheet

Close #1
Open "c:\a.csv" For Input As #1

MaxCommasPerRec = 8

Set wks = Workbooks.Add(1).Worksheets(1)
wks.Range("A1").EntireColumn.NumberFormat = "@" 'text

oRow = 0
Do While Not EOF(1)
Line Input #1, TextLine
CommaCtr = 0
StartPos = 1
For lCtr = 1 To Len(TextLine)
If Mid(TextLine, lCtr, 1) = "," Then
CommaCtr = CommaCtr + 1
If CommaCtr = MaxCommasPerRec Then
myStr = Mid(TextLine, StartPos, lCtr - StartPos + 1)
StartPos = lCtr + 1
oRow = oRow + 1
wks.Cells(oRow, "A").Value = myStr
CommaCtr = 0
End If
End If
Next lCtr
If StartPos < Len(TextLine) Then
'still something left in that text line
wks.Cells(oRow, "A").Value = Mid(TextLine, StartPos)
End If
Loop

Close #1

End Sub

 

[Jacob Skaria]

Instead of using Line input statement use Input statement which will read one
field at a time.
Input #intFile, F1, F2, F3, F4, F5, F6, F7, F8

OR split that to an array as below. Open a new workbook. Paste the macro and
try..


Sub Mac()
Dim intFile As Integer
Dim strData As String
Dim arrData As Variant
Dim lngRow As Long, lngCol As Long
intFile = FreeFile

On Error Resume Next

Open "c:\comma.txt" For Input As #intFile
Line Input #intFile, strData
arrData = Split(strData, ",")
For intTemp = 0 To UBound(arrData) Step 8
lngRow = lngRow + 1
For lngCol = 1 To 8
Cells(lngRow, lngCol) = arrData(intTemp + lngCol - 1)
Next
Next
Close #intFile

End Sub

If this post helps click Yes

 

[RyGuy]

Jacob, i think you need to Dim one more variable, right.
Dim intFile, inttemp As Integer

That worked for me.
Ryan--

 

[Billp]

Thanks To all,
Best Regards
Bill

Jacob, i think you need to Dim one more variable, right.
Dim intFile, inttemp As Integer

That worked for me.
Ryan--

 

[Jacob Skaria]

Yes Ryan; missed one (intTemp)...I havent used an IDE. Thanks for pointing
that out.

If this post helps click Yes

 

[KC]

I like this line input + split

Instead of using Line input statement use Input statement which will read
one
field at a time.
Input #intFile, F1, F2, F3, F4, F5, F6, F7, F8

OR split that to an array as below. Open a new workbook. Paste the macro
and
try..


Sub Mac()
Dim intFile As Integer
Dim strData As String
Dim arrData As Variant
Dim lngRow As Long, lngCol As Long
intFile = FreeFile

On Error Resume Next

Open "c:\comma.txt" For Input As #intFile
Line Input #intFile, strData
arrData = Split(strData, ",")
For intTemp = 0 To UBound(arrData) Step 8
lngRow = lngRow + 1
For lngCol = 1 To 8
Cells(lngRow, lngCol) = arrData(intTemp + lngCol - 1)
Next
Next
Close #intFile

End Sub

If this post helps click Yes

 

[Rick Rothstein]

How about this non-looping solution then?

Sub ImportText()
Dim R As Range
Dim X As Long, FileNum As Long
Dim TotalFile As String, Lines() As String
FileNum = FreeFile
Open "d:\temp\ExcelTest.txt" For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
Lines = Split(TotalFile, ",,")
Set R = ActiveSheet.Cells(2, "A").Resize(UBound(Lines) + 1)
R = WorksheetFunction.Transpose(Lines)
R.TextToColumns R(1), xlDelimited, xlTextQualifierNone, Comma:=True
End Sub

 

[Rick Rothstein]

You can remove the X As Long data declaration (this code was cannibalized
from an older posting of mine which had used the X variable).

 

[Rick Rothstein]

Here is a shorter (non-looping) routine that does the same thing as your
code (dumps each "record" into Column A)...

Sub ImportText()
Dim R As Range
Dim FileNum As Long
Dim TotalFile As String, Lines() As String
FileNum = FreeFile
Open "d:\temp\ExcelTest.txt" For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
Lines = Split(TotalFile, ",,")
Set R = ActiveSheet.Cells(2, "A").Resize(UBound(Lines) + 1)
R = WorksheetFunction.Transpose(Lines)
' R.TextToColumns R(1), xlDelimited, xlTextQualifierNone, Comma:=True
End Sub

Note that if you uncomment the last line, then the macro will distribute the
8 fields in each record into 8 individual columns.

 

[keiji kounoike]

Another version.
select new worksheet and run the macro, then data will be put into this
sheet.

Sub readtest()
Dim srow As Long, scolumn As Long, k As Long
Dim OneChr
Dim fileNum
Dim filename As String

filename = "C:\test.txt" '<<==Change to your data file
fileNum = FreeFile
Open filename For Input As fileNum
srow = 1 '<<==Change starting row number if you want
scolumn = 1 '<<==Change starting column number if you want
k = 0
Do While Not EOF(fileNum)
OneChr = Input(1, fileNum)
If OneChr = "," Then
k = k + 1
Cells(srow, scolumn) = WorksheetFunction.Clean(tmp)
scolumn = scolumn + 1
tmp = ""
Else
tmp = tmp & OneChr
End If

If k = 8 Then
srow = srow + 1
scolumn = 1
k = 0
End If
Loop
Close fileNum
End Sub

Keiji

 

[KC]

Even better.
I am imagining their speed.
Vooom

How about this non-looping solution then?

Sub ImportText()
Dim R As Range
Dim X As Long, FileNum As Long
Dim TotalFile As String, Lines() As String
FileNum = FreeFile
Open "d:\temp\ExcelTest.txt" For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
Lines = Split(TotalFile, ",,")
Set R = ActiveSheet.Cells(2, "A").Resize(UBound(Lines) + 1)
R = WorksheetFunction.Transpose(Lines)
R.TextToColumns R(1), xlDelimited, xlTextQualifierNone, Comma:=True
End Sub

 

[Dave Peterson]

But do watch out for those back to back commas that aren't the 7th and 8th.

 

[Rick Rothstein]

Good point!

Bill, if you come back to this thread, Dave's comment is about missing
data... my code will *only* work if there is *always* a value in each of the
eight fields of each record; that is, if any of those fields could be empty,
then this would allow two commas to be next to each other at a position
other than the location between records... if this could happen, then my
code would fail to work.

 

[Rick Rothstein]

There is one caveat that comes with my code, though... see Dave's latest
response to me and my response back to him.

 

[Dave Peterson]

And if those ",," characters only showed up where line breaks should have been,
I'd use my favorite text editor (I like UltraEdit) to change them vblfcr's.

Then I could open them normally.

Or even use code like this within excel:

Option Explicit
Sub testme02()

Dim FSO As Object
Dim RegEx As Object

Dim myFile As Object
Dim myContents As String
Dim myInFileName As String
Dim myOutFileName As String
Dim myString As String

myInFileName = "C:\a.csv"
myOutFileName = "C:\a.txt"

myString = ",,"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set myFile = FSO.OpenTextFile(myInFileName, 1, False)
myContents = myFile.ReadAll
myFile.Close

Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.Pattern = myString
myContents = Replace(myContents, ",," & vbCrLf, ",,")
myContents = Replace(myContents, ",,", vbCrLf)
End With

Set myFile = FSO.CreateTextFile(myOutFileName)
myFile.Write myContents
myFile.Close

End Sub

And then import the .txt file (recording a macro to get the fields correct).

Good point!

Bill, if you come back to this thread, Dave's comment is about missing
data... my code will *only* work if there is *always* a value in each of the
eight fields of each record; that is, if any of those fields could be empty,
then this would allow two commas to be next to each other at a position
other than the location between records... if this could happen, then my
code would fail to work.

 

[Rick Rothstein]

And for a non-FSO, non-RegEx macro to do the same thing, I would probably do
it this way (which, I'm thinking, might be faster)...

Sub ConvertCommaCommaToNewLine()
Dim FileNum As Long
Dim TotalFile As String
FileNum = FreeFile
Open "d:\temp\ExcelTest.txt" For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
FileNum = FreeFile
Open "d:\temp\ExcelTest.txt" For Output As #FileNum
Print #FileNum, Replace(TotalFile, ",,", vbNewLine)
Close #FileNum
End Sub

However, if you were going to use code to convert the double commas to
newlines just so you could import the file, then I would probably just use
the code I posted earlier and let it do the "import" for you.

 

[Billp]

To one and all I thank you again.

To change
Open "c:\comma.txt" For Input As #intFile

To one that asks the user to search, and input the text file via explorer.

I am really appreciative and humbled for all the help.
I cannot tick all for thank you for all deserve it.
Best and Kind Regards
Bill