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_Position,Clamp_Pressure,Current_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

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.ClearContents
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.Count)
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.Count)
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_Position,Clamp_Pressure,Current_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
>
>

On Nov 14, 5:20 pm, Joel <J...@discussions.microsoft.com> 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.ClearContents
> 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.Count)
> 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.Count)
> 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_Position,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 <J...@discussions.microsoft.com> 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.ClearContents
> > 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.Count)
> > 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.Count)
> > 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_Position,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 <J...@discussions.microsoft.com> 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.ClearContents
> > > 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.Count)
> > > 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.Count)
> > > 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_Position,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.ClearContents
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.ClearContents
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.Count)
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 <J...@discussions.microsoft.com> 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.ClearContents
> > > > 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.Count)
> > > > 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.Count)
> > > > 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_Position,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
> > >
>

On Nov 15, 5:14 pm, Joel <J...@discussions.microsoft.com> wrote:
> 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.ClearContents
> 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.ClearContents
> 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.Count)
> 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 <J...@discussions.microsoft.com> 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.ClearContents
> > > > > 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.Count)
> > > > > 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.Count)
> > > > > 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
>
> ...
>
> read more >>- Hide quoted text -
>
> - Show quoted text -

Thanks for that. That works fine if I have less than 65 536 rows of
data, but for 65 536 rows or greater it throws up the error:

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


on row:

If .Range("A" & RowCount) <> .Range("A" & RowCount + 1) Then

Any ideas?

Also once the data is in the sheets, I want to be able to plot a line
graph of the data. Currently I am doing this using one chart for each
sheet and dynamic ranges etc for each sheet. However is there a way I
can just have one chart on a seperate worksheet say 'graph output' and
from this and select which data (i.e. which date sheet) is displayed
on the graph using a drop down menu?

Thanks for all your help,

Regards

Joseph Crabtree

I didn't test for the 65,536 condition. After I sent the solution yesterday
I was wondering what happens when 65,536 occurs. The solution is simple,
stop the code at 65,535 instead of 536 and leave the last row of worksheet
temporary blank.

from:
If TempRowCount = Rows.Count Then
to:
If TempRowCount = (Rows.Count - 1) Then

Rows.count is a excel constant that is equal to 65,536.

"joecrabtree" wrote:

> On Nov 15, 5:14 pm, Joel <J...@discussions.microsoft.com> wrote:
> > 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.ClearContents
> > 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.ClearContents
> > 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.Count)
> > 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 <J...@discussions.microsoft.com> 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.ClearContents
> > > > > > 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.Count)
> > > > > > 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

On Nov 16, 2:07 pm, Joel <J...@discussions.microsoft.com> wrote:
> I didn't test for the 65,536 condition. After I sent the solution yesterday
> I was wondering what happens when 65,536 occurs. The solution is simple,
> stop the code at 65,535 instead of 536 and leave the last row of worksheet
> temporary blank.
>
> from:
> If TempRowCount = Rows.Count Then
> to:
> If TempRowCount = (Rows.Count - 1) Then
>
> Rows.count is a excel constant that is equal to 65,536.
>
>
>
> "joecrabtree" wrote:
> > On Nov 15, 5:14 pm, Joel <J...@discussions.microsoft.com> wrote:
> > > 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.ClearContents
> > > 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.ClearContents
> > > 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.Count)
> > > 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 <J...@discussions.microsoft.com> 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.ClearContents
> > > > > > > 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,
>
> ...
>
> read more >>- Hide quoted text -
>
> - Show quoted text -

That works now apart from : overflow error at:

Findsheet = LastRow + 1

Sorry to be a pain. Anything else i need to change?

Thanks

Joe

I think the problem is with the defintion of findsheet. Interger limit is
1/2 65,536 because integers they are both positive and negative. I think we
need to make it a long as shown below.
You aren't being a pain. it was my fault for not fully testing the code
uder every condition.

from
Function Findsheet(StrDate) As Integer
to
Function Findsheet(StrDate) As Long


"joecrabtree" wrote:

> On Nov 16, 2:07 pm, Joel <J...@discussions.microsoft.com> wrote:
> > I didn't test for the 65,536 condition. After I sent the solution yesterday
> > I was wondering what happens when 65,536 occurs. The solution is simple,
> > stop the code at 65,535 instead of 536 and leave the last row of worksheet
> > temporary blank.
> >
> > from:
> > If TempRowCount = Rows.Count Then
> > to:
> > If TempRowCount = (Rows.Count - 1) Then
> >
> > Rows.count is a excel constant that is equal to 65,536.
> >
> >
> >
> > "joecrabtree" wrote:
> > > On Nov 15, 5:14 pm, Joel <J...@discussions.microsoft.com> wrote:
> > > > 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.ClearContents
> > > > 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.ClearContents
> > > > 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.Count)
> > > > 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 <J...@discussions.microsoft.com> 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.ClearContents
> > > > > > > > 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,
> >