I use a macro to open the file 20061211.txt which is named after the date,
and extract some
data before closing it. I then repeat the process and open up the next file
20061212.txt and so on till I reach the last file 20061215.txt. I would
like to be able to use For N =1 to 5 and Next N, to automate the process but
I don't know how to increment the date by one each time. Any help will be
much appreciated.

TIA
Tom

Dim myStr as string
dim dCtr as long
dim myDate as date

for dctr = 1 to 5
myDate = dctr - 1 + dateserial(2006,12,11)
mystr = "C:\somepath\" & format(myDate,"yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
next dctr


Tom wrote:

I use a macro to open the file 20061211.txt which is named after the date,
and extract some
data before closing it. I then repeat the process and open up the next file
20061212.txt and so on till I reach the last file 20061215.txt. I would
like to be able to use For N =1 to 5 and Next N, to automate the process but
I don't know how to increment the date by one each time. Any help will be
much appreciated.

TIA
Tom

--

Dave Peterson

This is going to save me a lot of time. Skipping the weekends, presumably I
can next change the 11 in the dateserial to 18 and continue with the 2nd
week. However, can you create another loop to do this? Many thanks Dave.

Tom

"Dave Peterson" wrote in message
...
Dim myStr as string
dim dCtr as long
dim myDate as date

for dctr = 1 to 5
myDate = dctr - 1 + dateserial(2006,12,11)
mystr = "C:\somepath\" & format(myDate,"yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
next dctr


Tom wrote:

I use a macro to open the file 20061211.txt which is named after the
date,
and extract some
data before closing it. I then repeat the process and open up the next
file
20061212.txt and so on till I reach the last file 20061215.txt. I would
like to be able to use For N =1 to 5 and Next N, to automate the process
but
I don't know how to increment the date by one each time. Any help will be
much appreciated.

TIA
Tom

--

Dave Peterson

I'm not quite sure what you're doing, but if you're doing lots of dates and want
to skip all the weekends, you could just check inside the loop and not do the
work if it's a weekend day.

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

For dCtr = 1 To 50 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "C:\somepath\" & Format(myDate, "yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
End If
Next dCtr



Tom wrote:

This is going to save me a lot of time. Skipping the weekends, presumably I
can next change the 11 in the dateserial to 18 and continue with the 2nd
week. However, can you create another loop to do this? Many thanks Dave.

Tom

"Dave Peterson" wrote in message
...
Dim myStr as string
dim dCtr as long
dim myDate as date

for dctr = 1 to 5
myDate = dctr - 1 + dateserial(2006,12,11)
mystr = "C:\somepath\" & format(myDate,"yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
next dctr


Tom wrote:

I use a macro to open the file 20061211.txt which is named after the
date,
and extract some
data before closing it. I then repeat the process and open up the next
file
20061212.txt and so on till I reach the last file 20061215.txt. I would
like to be able to use For N =1 to 5 and Next N, to automate the process
but
I don't know how to increment the date by one each time. Any help will be
much appreciated.

TIA
Tom

--

Dave Peterson

--

Dave Peterson

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of dates
and want
to skip all the weekends, you could just check inside the loop and not do
the
work if it's a weekend day.
Yes. That's exactly what I'm doing. All days of the week except the weekends
and am collecting the data for several years. But I thought I would just
start looking at a week and progressively increase the investigation. I
shall now try your new codes and let you know how well it does what I want.
Thanks again, Dave.

Tom


Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

For dCtr = 1 To 50 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "C:\somepath\" & Format(myDate, "yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
End If
Next dCtr



Tom wrote:

This is going to save me a lot of time. Skipping the weekends, presumably
I
can next change the 11 in the dateserial to 18 and continue with the 2nd
week. However, can you create another loop to do this? Many thanks Dave.

Tom

"Dave Peterson" wrote in message
...
Dim myStr as string
dim dCtr as long
dim myDate as date

for dctr = 1 to 5
myDate = dctr - 1 + dateserial(2006,12,11)
mystr = "C:\somepath\" & format(myDate,"yyyymmdd") & ".txt"
'open the file named myStr
'do some work
'close that .txt file
next dctr


Tom wrote:

I use a macro to open the file 20061211.txt which is named after the
date,
and extract some
data before closing it. I then repeat the process and open up the next
file
20061212.txt and so on till I reach the last file 20061215.txt. I
would
like to be able to use For N =1 to 5 and Next N, to automate the
process
but
I don't know how to increment the date by one each time. Any help will
be
much appreciated.

TIA
Tom

--

Dave Peterson

--

Dave Peterson

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of dates
and want
to skip all the weekends, you could just check inside the loop and not do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices for a
particular stock (say APA), and assembling the data in the file newdata.csv,
over a number of years. I've included the codes below. With your new codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file as I
am not able to tell which was the last file it had open. Secondly, when
doing it manually, if it had found the wrong code, like "APAO" instead of
"APA", I would simply ask it to find it again until I could see that it was
the right one before proceeding. Is there a way to test this? Thanks for any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv", Origin:= _
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True, FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match entire cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook. So you can
use that to assign a variable that represents that newly opened text file.

If you open a .xls (or .csv), you can set a variable when you open that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") & ".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of dates
and want
to skip all the weekends, you could just check inside the loop and not do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices for a
particular stock (say APA), and assembling the data in the file newdata.csv,
over a number of years. I've included the codes below. With your new codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file as I
am not able to tell which was the last file it had open. Secondly, when
doing it manually, if it had found the wrong code, like "APAO" instead of
"APA", I would simply ask it to find it again until I could see that it was
the right one before proceeding. Is there a way to test this? Thanks for any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv", Origin:= _
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True, FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

Thanks again, Dave. It is testing ok with regard to the last two problems.
The new problem it throws up is when the file of a particular day is missing
e.g. when it is a public holiday, the debug screen pops up. How can I ask it
to skip and keep skipping (like when it is the Christmas break) until the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook. So
you can
use that to assign a variable that represents that newly opened text file.

If you open a .xls (or .csv), you can set a variable when you open that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of dates
and want
to skip all the weekends, you could just check inside the loop and not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your new
codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file as
I
am not able to tell which was the last file it had open. Secondly, when
doing it manually, if it had found the wrong code, like "APAO" instead of
"APA", I would simply ask it to find it again until I could see that it
was
the right one before proceeding. Is there a way to test this? Thanks for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv", Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") & ".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two problems.
The new problem it throws up is when the file of a particular day is missing
e.g. when it is a public holiday, the debug screen pops up. How can I ask it
to skip and keep skipping (like when it is the Christmas break) until the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook. So
you can
use that to assign a variable that represents that newly opened text file.

If you open a .xls (or .csv), you can set a variable when you open that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of dates
and want
to skip all the weekends, you could just check inside the loop and not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your new
codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file as
I
am not able to tell which was the last file it had open. Secondly, when
doing it manually, if it had found the wrong code, like "APAO" instead of
"APA", I would simply ask it to find it again until I could see that it
was
the right one before proceeding. Is there a way to test this? Thanks for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv", Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

That's wonderful, Dave. It is working without a hitch even with data missing
over a week. It is going to save me a lot of time. You are an excellent
teacher and helper. Many thanks.

Tom

"Dave Peterson" wrote in message
...
Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two
problems.
The new problem it throws up is when the file of a particular day is
missing
e.g. when it is a public holiday, the debug screen pops up. How can I ask
it
to skip and keep skipping (like when it is the Christmas break) until the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match
entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook. So
you can
use that to assign a variable that represents that newly opened text
file.

If you open a .xls (or .csv), you can set a variable when you open that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of
dates
and want
to skip all the weekends, you could just check inside the loop and
not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices
for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your new
codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file
as
I
am not able to tell which was the last file it had open. Secondly,
when
doing it manually, if it had found the wrong code, like "APAO" instead
of
"APA", I would simply ask it to find it again until I could see that
it
was
the right one before proceeding. Is there a way to test this? Thanks
for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv",
Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd")
&
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6,
1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

Whew!

Glad you got it working.

Tom wrote:

That's wonderful, Dave. It is working without a hitch even with data missing
over a week. It is going to save me a lot of time. You are an excellent
teacher and helper. Many thanks.

Tom

"Dave Peterson" wrote in message
...
Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two
problems.
The new problem it throws up is when the file of a particular day is
missing
e.g. when it is a public holiday, the debug screen pops up. How can I ask
it
to skip and keep skipping (like when it is the Christmas break) until the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match
entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook. So
you can
use that to assign a variable that represents that newly opened text
file.

If you open a .xls (or .csv), you can set a variable when you open that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of
dates
and want
to skip all the weekends, you could just check inside the loop and
not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices
for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your new
codes
I'm now able to automate the process. It fetches and opens the files
correctly. However, with sight unseen, I am not able to close the file
as
I
am not able to tell which was the last file it had open. Secondly,
when
doing it manually, if it had found the wrong code, like "APAO" instead
of
"APA", I would simply ask it to find it again until I could see that
it
was
the right one before proceeding. Is there a way to test this? Thanks
for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv",
Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd")
&
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6,
1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

"Dave Peterson" wrote in message
...
Whew!
I know you are just joking.
With your command of VBA, you could easily knock off a financial system in
one weekend (:))

Glad you got it working.

Tom wrote:

That's wonderful, Dave. It is working without a hitch even with data
missing
over a week. It is going to save me a lot of time. You are an excellent
teacher and helper. Many thanks.

Tom

"Dave Peterson" wrote in message
...
Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two
problems.
The new problem it throws up is when the file of a particular day is
missing
e.g. when it is a public holiday, the debug screen pops up. How can I
ask
it
to skip and keep skipping (like when it is the Christmas break) until
the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match
entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook.
So
you can
use that to assign a variable that represents that newly opened text
file.

If you open a .xls (or .csv), you can set a variable when you open
that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1,
0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas,
_
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of
dates
and want
to skip all the weekends, you could just check inside the loop
and
not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices
for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your
new
codes
I'm now able to automate the process. It fetches and opens the
files
correctly. However, with sight unseen, I am not able to close the
file
as
I
am not able to tell which was the last file it had open. Secondly,
when
doing it manually, if it had found the wrong code, like "APAO"
instead
of
"APA", I would simply ask it to find it again until I could see
that
it
was
the right one before proceeding. Is there a way to test this?
Thanks
for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv",
Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd")
&
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6,
1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

The last time I knocked off a financial system they made a movie about it:

http://www.imdb.com/title/tt0240772/

<vbg

Tom wrote:

"Dave Peterson" wrote in message
...
Whew!
I know you are just joking.
With your command of VBA, you could easily knock off a financial system in
one weekend (:))

Glad you got it working.

Tom wrote:

That's wonderful, Dave. It is working without a hitch even with data
missing
over a week. It is going to save me a lot of time. You are an excellent
teacher and helper. Many thanks.

Tom

"Dave Peterson" wrote in message
...
Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate, "yyyymmdd") &
".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two
problems.
The new problem it throws up is when the file of a particular day is
missing
e.g. when it is a public holiday, the debug screen pops up. How can I
ask
it
to skip and keep skipping (like when it is the Christmas break) until
the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to match
entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the activeworkbook.
So
you can
use that to assign a variable that represents that newly opened text
file.

If you open a .xls (or .csv), you can set a variable when you open
that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1,
0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count), LookIn:=xlFormulas,
_
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots of
dates
and want
to skip all the weekends, you could just check inside the loop
and
not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock prices
for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your
new
codes
I'm now able to automate the process. It fetches and opens the
files
correctly. However, with sight unseen, I am not able to close the
file
as
I
am not able to tell which was the last file it had open. Secondly,
when
doing it manually, if it had found the wrong code, like "APAO"
instead
of
"APA", I would simply ask it to find it again until I could see
that
it
was
the right one before proceeding. Is there a way to test this?
Thanks
for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv",
Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd")
&
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6,
1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

Well done!

"Dave Peterson" wrote in message
...
The last time I knocked off a financial system they made a movie about it:

http://www.imdb.com/title/tt0240772/

<vbg

Tom wrote:

"Dave Peterson" wrote in message
...
Whew!
I know you are just joking.
With your command of VBA, you could easily knock off a financial system
in
one weekend (:))

Glad you got it working.

Tom wrote:

That's wonderful, Dave. It is working without a hitch even with data
missing
over a week. It is going to save me a lot of time. You are an
excellent
teacher and helper. Many thanks.

Tom

"Dave Peterson" wrote in message
...
Still untested...

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range
Dim TestStr As String

Set NewDataWkbk = Workbooks.Open _
(Filename:="D:\Echart\Download\newdata.csv")
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1,
0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd") &
".txt"

TestStr = ""
On Error Resume Next
TestStr = Dir(myStr)
On Error GoTo 0

If TestStr = "" Then
'do nothing, that filename doesn't exist.
Else
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1),
Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6,
1), _
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just
opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
End If
Next dCtr

End Sub


Tom wrote:

Thanks again, Dave. It is testing ok with regard to the last two
problems.
The new problem it throws up is when the file of a particular day
is
missing
e.g. when it is a public holiday, the debug screen pops up. How can
I
ask
it
to skip and keep skipping (like when it is the Christmas break)
until
the
next available file is found?

"Dave Peterson" wrote in message
...
First, this is untested--but it did compile.

Second, when you do a find in excel, you can set an option to
match
entire
cell
contents. In code, you'd use xlWhole instead of xlPart.

And as soon as you open a text file, it becomes the
activeworkbook.
So
you can
use that to assign a variable that represents that newly opened
text
file.

If you open a .xls (or .csv), you can set a variable when you
open
that
workbook.

Option Explicit
Sub Build_Data()

Dim myStr As String
Dim dCtr As Long
Dim myDate As Date
Dim NewDataWkbk As Workbook
Dim TxtWkbk As Workbook
Dim FoundCell As Range
Dim DestCell As Range

Set NewDataWkbk = Workbooks.Open _

(Filename:="D:\Echart\Download\newdata.csv")

'Paste into the next available row in the .CSV file?
With NewDataWkbk.Worksheets(1)
Set DestCell = .Cells(.Rows.Count,
"A").End(xlUp).Offset(1,
0)
End With

For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd") &
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=True, Semicolon:=False, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1),
Array(3,
1),
_
Array(4, 1), Array(5, 1), Array(6, 1),
_
Array(7, 1)), _
TrailingMinusNumbers:=True
Set TxtWkbk = ActiveWorkbook 'the text file just
opened

With TxtWkbk.Worksheets(1)
Set FoundCell = .Cells.Find(What:="APA", _
After:=.cells(.cells.count),
LookIn:=xlFormulas,
_
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
End With

If FoundCell Is Nothing Then
'not found, skip this file??
Else
FoundCell.EntireRow.Resize(1, 7).Copy _
Destination:=DestCell
'get ready for next file
Set DestCell = DestCell.Offset(1, 0)
End If
TxtWkbk.Close savechanges:=False
End If
Next dCtr

End Sub



Tom wrote:

"Dave Peterson" wrote in message
...
I'm not quite sure what you're doing, but if you're doing lots
of
dates
and want
to skip all the weekends, you could just check inside the loop
and
not
do
the
work if it's a weekend day.
<snip

What I'm trying to do is, extracting the day's trading stock
prices
for a
particular stock (say APA), and assembling the data in the file
newdata.csv,
over a number of years. I've included the codes below. With your
new
codes
I'm now able to automate the process. It fetches and opens the
files
correctly. However, with sight unseen, I am not able to close
the
file
as
I
am not able to tell which was the last file it had open.
Secondly,
when
doing it manually, if it had found the wrong code, like "APAO"
instead
of
"APA", I would simply ask it to find it again until I could see
that
it
was
the right one before proceeding. Is there a way to test this?
Thanks
for
any
suggestions.

Sub Build_Data()
'
' Build_Data Macro
' Macro recorded 29/12/2006 by Tom
'

'
Dim myStr As String
Dim dCtr As Long
Dim myDate As Date

' Workbooks.Open Filename:="D:\Echart\Download\newdata.csv",
Origin:=
_
xlWindows
Workbooks.Open Filename:="D:\Echart\Download\newdata.csv"
Range("A1").Select
For dCtr = 1 To 10 'some big number
myDate = dCtr - 1 + DateSerial(2006, 12, 11)
If Weekday(myDate) = vbSaturday _
Or Weekday(myDate) = vbSunday Then
'do nothing
Else
myStr = "D:\Echart\Download\" & Format(myDate,
"yyyymmdd")
&
".txt"
Workbooks.OpenText Filename:=myStr, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote,
_
Tab:=True, Semicolon:=False, Comma:=True,
FieldInfo:=Array(Array(1,
1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6,
1),
_
Array(7, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="APA", After:=ActiveCell,
LookIn:=xlFormulas,
LookAt:=
_
xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate ' how to match?
ActiveCell.Range("A1:G1").Select
Selection.Copy
Windows("newdata.csv").Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Windows("20061211.txt").Activate ' how to close after
looping?
Application.CutCopyMode = False
ActiveWorkbook.Close
End If
Next dCtr

End Sub

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson