I quickly modified some code from some other postings. This coded puts all
the data read on one worksheet. Modify Folder = "C:\temp\test" to be used as
a default folder incase somebody hits canceled in the pop up menu.


Sub GetCSVData()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0



Set fsread = CreateObject("Scripting.FileSystemObject")

'default folder
Folder = "C:\temp\test"

Newfolder = Application.GetOpenFilename("CSV (*.csv),*.csv")
If Not Newfolder = False Then
Folder = ""
Do While InStr(Newfolder, "\") 0
Folder = Folder & Left(Newfolder, InStr(Newfolder, "\"))
Newfolder = Mid(Newfolder, InStr(Newfolder, "\") + 1)
Loop
'remove last character which is a \
Folder = Left(Folder, Len(Folder) - 1)
End If

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
RowCount = Lastrow + 1First = 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
ColumnCount = 1
Do While InputLine < ""
CommaPosition = InStr(InputLine, ",")
If CommaPosition 0 Then
data = Trim(Left(InputLine, CommaPosition - 1))
InputLine = Mid(InputLine, CommaPosition + 1)
Else
data = Trim(InputLine)
InputLine = ""
End If

Cells(RowCount, ColumnCount) = data
ColumnCount = ColumnCount + 1
Loop
RowCount = RowCount + 1
Loop

tsread.Close
End If
Loop While Filename < ""
End Sub


"Jim G" wrote:

Following from the previous post.

When the Sheet "DATA" is updated your "Movedata1()" macro is run on
Worksheet_Change(ByVal Target As Range)

I have used the code below that I copied from Chip Pearson to export the
text from the Sheet "TEXT" to a file "Test.txt".

Since your code adds the commas, I've removed the comma characters (assumed
to be CHR (34)) because it was adding commas for the blank (unused) cells in
Sheet "TEXT". I hope this hasn't any unforeseen consequences.

The result is perfect and the text data is apended each time I open a new
data file. Is there a way i could open several files (or a whole directory)
at once and append one after the otehr until done and the data files closed?

My objective is to have the user download all the site data files then run
these macros in a template to create a single data file to upload the text
file into our maintenance scheduling software. Currently the user manually
copies all the plant data from each site files (dozens per week) to another
excel file then saves the file as a CSV file ready for uploading, then spends
the rest of the day looking for and correcting the typos when the file is
rejected due to errors.

I hope you don't mind the detail, I mention this to demonstrate the emense
value you have provided and the extent of my appreciation.

-----------------------------------------------------------
I call this with Chips: Sub DoTheExport()


ExportToTextFile FName:="T:\Test.txt", Sep:=";", _
SelectionOnly:=False, AppendData:=True

End Sub


Chip Pearsons code:

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Sheets("Text").Select

Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = "" 'Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub
--
Jim


"Joel" wrote:

Here is modified code. I assumed in this new code the DT35 was in column A
(not B), tnherefore I had to extract the DT35 from the rest of the column A
data.


Sub movedata1()

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Sh1RowCount = 1
Sh2RowCount = 1
Do While Sh1RowCount <= LastRow
ColAData = .Range("A" & Sh1RowCount)
If InStr(ColAData, "Plant No:") 0 Then
'extract the number only
PlantNo = Trim(Mid(ColAData, InStr(ColAData, ":") + 1))
SMUEND = .Range("D" & (Sh1RowCount + 2))
NewDate = .Range("A" & (Sh1RowCount + 2))
StringData = PlantNo & ",," & SMUEND & _
"," & NewDate
With Sheets("Sheet2")
.Range("A" & Sh2RowCount) = StringData
Sh2RowCount = Sh2RowCount + 1
End With
End If
Sh1RowCount = Sh1RowCount + 1
Loop
End With
End Sub

"Jim G" wrote:

I have a data set that I download to excel and I need to select specifica
data to import into another programme. The raw data looks like this.


Row Col A Col B Col C Col D Col E
Col F
9 Date Shift Type SMU Start SMU End SMU Total Error Gap
10
11
12 Type: 45D (DUMPER)
13
14
15 Plant No: DT35
16
17 19/11/2007 DAY 4,904.00 4,977.00 73.00 0.00

This repeats for each plant number with the same row spacing.

I would like to use a macro to create a unique list for each plant item
("DT35") followed by two commas (,,) the SMU End (Col D unformatted) comma
and the date (DD/MM/YYYY). EG "DT35,,4977,19/11/2007 all in column A of a
new sheet wthout headings.

The lists will vary in length with each site.
--
Jim