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 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 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.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,