Data search and extraction from multiple text files query
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
|