To all,


I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Current_Job,Toolslide_Positi on,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0


The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree

This is a little complicated but it works well good.

You need to modify this line to point to the directory where the data is
located
Const Folder = "C:\temp\test"

Change this line for different Job Numbers

Const JobNumber = 35900




Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If


Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
TempRowCount = TempRowCount + 1
End If
Loop

tsread.Close
End If
Loop While Filename < ""

With ThisWorkbook.Sheets("Temporary")

Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & Lastrow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)

StrDate = NewYear & "_" & NewMonth & "_" & NewDay
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
NewDate = .Range("A" & RowCount + 1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)
StrDate = NewYear & "_" & NewMonth & "_" & NewDay
ActiveSheet.Name = StrDate
End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub


"joecrabtree" wrote:

To all,


I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Current_Job,Toolslide_Positi on,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0


The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree

On Nov 14, 5:20 pm, Joel wrote:
This is a little complicated but it works well good.

You need to modify this line to point to the directory where the data is
located
Const Folder = "C:\temp\test"

Change this line for different Job Numbers

Const JobNumber = 35900

Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If

Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
TempRowCount = TempRowCount + 1
End If
Loop

tsread.Close
End If
Loop While Filename < ""

With ThisWorkbook.Sheets("Temporary")

Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & Lastrow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)

StrDate = NewYear & "_" & NewMonth & "_" & NewDay
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
NewDate = .Range("A" & RowCount + 1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)
StrDate = NewYear & "_" & NewMonth & "_" & NewDay
ActiveSheet.Name = StrDate
End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub



"joecrabtree" wrote:
To all,

I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Cur-rent_Job,Toolslide_Position,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0

The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree- Hide quoted text -

- Show quoted text -

Thanks for that. I however have one problem. When I run it it comes
back with the following error message:

'Run time error '1004' Application defined object or object define
error

This occurs at .Cells(TempRowCount, i) = field(i)

I am assuming this is because I have used over 65000 rows of data in
excel. Is there any way that after it has imported say 60000 lines of
data, it puts the next set on a second sheet i.e. temporary 2 etc?
Also will the data split by date function have to be modified
accordingly?

Thanks

Joseph Crabtree

I don't like making assumptions. Not sure if we got to 65,536 lines or if
Temprowcount just have to be defined as a long. Can you check how many rows
are filled onthe temporary worksheet. If 65,536 rows are filled then we need
to modify the code. If there are less than 65,536 then try adding a statement

Dim TempRowCount as long

"joecrabtree" wrote:

On Nov 14, 5:20 pm, Joel wrote:
This is a little complicated but it works well good.

You need to modify this line to point to the directory where the data is
located
Const Folder = "C:\temp\test"

Change this line for different Job Numbers

Const JobNumber = 35900

Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If

Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
TempRowCount = TempRowCount + 1
End If
Loop

tsread.Close
End If
Loop While Filename < ""

With ThisWorkbook.Sheets("Temporary")

Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & Lastrow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)

StrDate = NewYear & "_" & NewMonth & "_" & NewDay
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
NewDate = .Range("A" & RowCount + 1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)
StrDate = NewYear & "_" & NewMonth & "_" & NewDay
ActiveSheet.Name = StrDate
End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub



"joecrabtree" wrote:
To all,

I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Cur-rent_Job,Toolslide_Position,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0

The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree- Hide quoted text -

- Show quoted text -

Thanks for that. I however have one problem. When I run it it comes
back with the following error message:

'Run time error '1004' Application defined object or object define
error

This occurs at .Cells(TempRowCount, i) = field(i)

I am assuming this is because I have used over 65000 rows of data in
excel. Is there any way that after it has imported say 60000 lines of
data, it puts the next set on a second sheet i.e. temporary 2 etc?
Also will the data split by date function have to be modified
accordingly?

Thanks

Joseph Crabtree

Joel,

65536 rows are filled.

Thanks

Joe

Joel wrote:
I don't like making assumptions. Not sure if we got to 65,536 lines or if
Temprowcount just have to be defined as a long. Can you check how many rows
are filled onthe temporary worksheet. If 65,536 rows are filled then we need
to modify the code. If there are less than 65,536 then try adding a statement

Dim TempRowCount as long

"joecrabtree" wrote:

On Nov 14, 5:20 pm, Joel wrote:
This is a little complicated but it works well good.

You need to modify this line to point to the directory where the data is
located
Const Folder = "C:\temp\test"

Change this line for different Job Numbers

Const JobNumber = 35900

Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If

Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
TempRowCount = TempRowCount + 1
End If
Loop

tsread.Close
End If
Loop While Filename < ""

With ThisWorkbook.Sheets("Temporary")

Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & Lastrow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)

StrDate = NewYear & "_" & NewMonth & "_" & NewDay
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
NewDate = .Range("A" & RowCount + 1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)
StrDate = NewYear & "_" & NewMonth & "_" & NewDay
ActiveSheet.Name = StrDate
End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub



"joecrabtree" wrote:
To all,

I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Cur-rent_Job,Toolslide_Position,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0

The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree- Hide quoted text -

- Show quoted text -

Thanks for that. I however have one problem. When I run it it comes
back with the following error message:

'Run time error '1004' Application defined object or object define
error

This occurs at .Cells(TempRowCount, i) = field(i)

I am assuming this is because I have used over 65000 rows of data in
excel. Is there any way that after it has imported say 60000 lines of
data, it puts the next set on a second sheet i.e. temporary 2 etc?
Also will the data split by date function have to be modified
accordingly?

Thanks

Joseph Crabtree

Try this code. I made the code modula adding a function and a subroutine to
perform functions required in multiple places in the code. When 65,536 lines
are reached I move the data to individual sheets and then clear the temporary
page.

I modified the date so a serial date is inserted in the worksheet instead of
the string date that existed in the previous code.

Remember to chage the path name
Const Folder = "C:\temp\test"

Also I'm searching for files *.csv (I assume the this is the name of the
files).


Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If


Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then

'convert data to a serial format
NewDate = field(1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Val(Left(NewDate, InStr(NewDate, "/") - 1))
NewDay = Val(Mid(NewDate, InStr(NewDate, "/") + 1))
field(1) = DateSerial(NewYear, NewMonth, NewDay)
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
If TempRowCount = Rows.Count Then
Call movedata
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
TempRowCount = 1
Else
TempRowCount = TempRowCount + 1
End If
End If
Loop

tsread.Close
End If
Loop While Filename < ""
If Not IsEmpty(ThisWorkbook.Worksheets("Temporary").Range ("A1")) Then
Call movedata
End If
End Sub
Sub movedata()
With ThisWorkbook.Sheets("Temporary")

LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & LastRow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
StrDate = Year(NewDate) & "_" & Month(NewDate) & "_" & Day(NewDate)
NewRowCount = Findsheet(StrDate)

RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewDate = .Range("A" & RowCount + 1)
StrDate = Year(NewDate) & "_" & Month(NewDate) & "_" &
Day(NewDate)
NewRowCount = Findsheet(StrDate)

End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub

Function Findsheet(StrDate) As Integer

'check if worksheet exists
Found = False
For Each wbk In ThisWorkbook.Sheets
If wbk.Name = StrDate Then
Found = True
Exit For
End If
Next wbk

If Found = True Then
LastRow = wbk.Cells(Rows.Count, "A").End(xlUp).Row
Findsheet = LastRow + 1
Else
Findsheet = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
End If

End Function


"joecrabtree" wrote:

Joel,

65536 rows are filled.

Thanks

Joe

Joel wrote:
I don't like making assumptions. Not sure if we got to 65,536 lines or if
Temprowcount just have to be defined as a long. Can you check how many rows
are filled onthe temporary worksheet. If 65,536 rows are filled then we need
to modify the code. If there are less than 65,536 then try adding a statement

Dim TempRowCount as long

"joecrabtree" wrote:

On Nov 14, 5:20 pm, Joel wrote:
This is a little complicated but it works well good.

You need to modify this line to point to the directory where the data is
located
Const Folder = "C:\temp\test"

Change this line for different Job Numbers

Const JobNumber = 35900

Sub GetFurnaceData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const Folder = "C:\temp\test"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const JobNumber = 35900
Dim field(11)

'check if temporary worksheet exists
Found = False
For Each sht In ThisWorkbook.Sheets
If sht.Name = "Temporary" Then
Found = True
Exit For
End If
Next sht

If Found = False Then
With ThisWorkbook.Sheets
.Add after:=ThisWorkbook.Sheets(.Count)
ActiveSheet.Name = "Temporary"
End With
Else
ThisWorkbook.Worksheets("Temporary").Cells.ClearCo ntents
End If

Set fsread = CreateObject("Scripting.FileSystemObject")
TempRowCount = 1
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.csv")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
'open files
Set fread = fsread.GetFile(Folder & "\" & Filename)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

Do While tsread.atendofstream = False

Inputline = tsread.Readline

'extract comma seperated data
For i = 1 To 11
If i < 11 Then
CommaPosition = InStr(Inputline, ",")
If CommaPosition 0 Then
data = Trim(Left(Inputline, CommaPosition - 1))
Inputline = Mid(Inputline, CommaPosition + 1)
field(i) = data
Else
field(i) = ""
End If
Else
field(i) = Trim(Inputline)
End If
Next i
If JobNumber = Val(field(7)) Then
For i = 1 To 11
With ThisWorkbook.Sheets("Temporary")
.Cells(TempRowCount, i) = field(i)
End With
Next i
TempRowCount = TempRowCount + 1
End If
Loop

tsread.Close
End If
Loop While Filename < ""

With ThisWorkbook.Sheets("Temporary")

Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
'Sort by date
.Range("A1:K" & Lastrow).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
DataOption1:=xlSortNormal

'move data to sheets by date
NewDate = .Range("A1")
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)

StrDate = NewYear & "_" & NewMonth & "_" & NewDay
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = StrDate
RowCount = 1
Do While .Range("A" & RowCount) < ""
.Rows(RowCount).Copy Destination:= _
ThisWorkbook.Sheets(StrDate).Rows(NewRowCount)
NewRowCount = NewRowCount + 1
If .Range("A" & RowCount) < .Range("A" & RowCount + 1) Then
If .Range("A" & RowCount + 1) < "" Then
NewRowCount = 1
ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
NewDate = .Range("A" & RowCount + 1)
NewYear = Val(Left(NewDate, 4))
NewDate = Mid(NewDate, 6)
NewMonth = Left(NewDate, InStr(NewDate, "/") - 1)
NewDay = Mid(NewDate, InStr(NewDate, "/") + 1)
StrDate = NewYear & "_" & NewMonth & "_" & NewDay
ActiveSheet.Name = StrDate
End If
End If
RowCount = RowCount + 1
Loop
End With
End Sub



"joecrabtree" wrote:
To all,

I have a series of comma seperated text files. One for each day of the
year. They are identified by the title RD071107, RD071108 etc. - This
denotes the date that the data was collected (yy/mm/dd). In each text
file there is comma serpated data in the format shown below:

Date,Time,Pierce_Position,Pierce_Pressure,Clamp_Po sition,Clamp_Pressure,Cur-rent_Job,Toolslide_Position,Press
Mode,Rotary 1 Furnace Temperature,Rotary 2 Furnace Temperature
2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0
2007/13/11,08:44:12,541.,92.,2,472.,35602,4,Auto,0,0
2007/13/11,08:44:13,697.,93.,2,468.,35602,4,Auto,0,0
2007/13/11,08:44:13,877.,94.,1,465.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,94.,1,462.,35602,4,Auto,0,0
2007/13/11,08:44:14,1012.,84.,1,459.,35602,4,Auto,0,0
2007/13/11,08:44:15,1206.,74.,1,456.,35602,4,Auto,0,0
2007/13/11,08:44:15,1259.,69.,1,454.,35602,4,Auto,0,0
2007/13/11,08:44:16,1290.,72.,1,452.,35602,4,Manual,0,0

The important data for me is the current_job number which is a 5 digit
numeric number - in the example above it is 35900. Each text file
contains multiple job numbers.

What I want to be able to do is search through each text file (one per
day in a master folder) and extract all the data for a particular job.
So for the job number 35900 it would extract the following from the
text file. It would repeat this for each day.

2007/13/11,01:02:41,1506.,32.,-2,4102.,35900,2,Manual,0,0
2007/13/11,01:02:41,1506.,31.,-2,4379.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,32.,-2,4378.,35900,2,Manual,0,0
2007/13/11,01:02:42,1506.,31.,-2,4363.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4345.,35900,2,Manual,0,0
2007/13/11,01:02:43,1506.,31.,-2,4328.,35900,2,Manual,0,0

I then want to be able to import the data found into an excel workbook
titled with the job number 35900, with a seperate worksheet for each
day of data extracted.

Is there a quick way to do this, if so any help would be appreciated.

Thanks in advance for your help,

Regard

Joseph Crabtree- Hide quoted text -

- Show quoted text -

Thanks for that. I however have one problem. When I run it it comes
back with the following error message:

'Run time error '1004' Application defined object or object define
error

This occurs at .Cells(TempRowCount, i) = field(i)

I am assuming this is because I have used over 65000 rows of data in
excel. Is there any way that after it has imported say 60000 lines of
data, it puts the next set on a second sheet i.e. temporary 2 etc?
Also will the data split by date function have to be modified
accordingly?

Thanks

Joseph Crabtree