I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?

Thanks in advance
--
There are 10 types of people in the world - those who understand binary and
those who don't.

All I could see to do is trim around the edges a little...
Using object references for the worksheets.
Using variables so as to eliminate the addition/subtraction in the loop.

Is Calculation set to manual and ScreenUpdating turned off?
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)

'----------------------
Dim adjustQuarters As Long
Dim wsData As Excel.Worksheet
Dim wsText As Excel.Worksheet
Set wsData = wbkCurrentTri.Sheets("Data")

Workbooks.OpenText Filename:=strFilePath & strTxtName, DataType:=xlDelimited
Set wsText = ActiveWorkbook.Sheets(1)
NumAcctOrder = NumAcctOrder - 1
adjustQuarters = NumQuarters + 2

'Copy the creation date
wsData.Cells(5 + 150 * NumAcctOrder, 67).Value = _
wsText.Cells(2, 2).Value

'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
wsData.Cells(8 + q + 150 * NumAcctOrder, 67).Value = _
wsText.Cells(11 + q, adjustQuarters - q).Value
Next q
'Close the text file
wsText.Parent.Close
NumAcctOrder = NumAcctOrder + 1
'----------------------



"Geoff"
wrote in message
I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?
Thanks in advance
--
There are 10 types of people in the world - those who understand binary and
those who don't.

You might try the following untested replacement code; the greater the
value of NumQuarters, the more the improvement:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText Filename:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
Set rng = .Range(.Cells(8 + 1 + 150 * (NumAcctOrder - 1),
67), _ .Cells(8 + NumQuarters + 150 * (NumAcctOrder - 1), 67))
Dim arr()
ReDim arr(1 To NumQuarters, 1 To 1)
For q = 1 To NumQuarters 'Loop for the number of quarters
arr(q, 1) = wbkTxt.Sheets(1).Cells(11 + q, 2 + _
NumQuarters - q).Value
Next q
rng.Value = arr
'Close the text file
wbkTxt.Close
End With

Alan Beban

Geoff wrote:
I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?

Thanks in advance

Thanks Jim, I'll give that a try.

As you say, trimming around the edges may be all that's possible for
now...the bottom line is there is a lot of work to be done, which may be
handled better in another application. Long term, we may use SAS to process
the text files and export to Excel.

Cheers
Geoff
--
There are 10 types of people in the world - those who understand binary and
those who don't.


"Jim Cone" wrote:


All I could see to do is trim around the edges a little...
Using object references for the worksheets.
Using variables so as to eliminate the addition/subtraction in the loop.

Is Calculation set to manual and ScreenUpdating turned off?
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)

'----------------------
Dim adjustQuarters As Long
Dim wsData As Excel.Worksheet
Dim wsText As Excel.Worksheet
Set wsData = wbkCurrentTri.Sheets("Data")

Workbooks.OpenText Filename:=strFilePath & strTxtName, DataType:=xlDelimited
Set wsText = ActiveWorkbook.Sheets(1)
NumAcctOrder = NumAcctOrder - 1
adjustQuarters = NumQuarters + 2

'Copy the creation date
wsData.Cells(5 + 150 * NumAcctOrder, 67).Value = _
wsText.Cells(2, 2).Value

'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
wsData.Cells(8 + q + 150 * NumAcctOrder, 67).Value = _
wsText.Cells(11 + q, adjustQuarters - q).Value
Next q
'Close the text file
wsText.Parent.Close
NumAcctOrder = NumAcctOrder + 1
'----------------------



"Geoff"
wrote in message
I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?
Thanks in advance
--
There are 10 types of people in the world - those who understand binary and
those who don't.

Thanks Alan, I'll try that.

Cheers
Geoff
--
There are 10 types of people in the world - those who understand binary and
those who don't.


"Alan Beban" wrote:

You might try the following untested replacement code; the greater the
value of NumQuarters, the more the improvement:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText Filename:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
Set rng = .Range(.Cells(8 + 1 + 150 * (NumAcctOrder - 1),
67), _ .Cells(8 + NumQuarters + 150 * (NumAcctOrder - 1), 67))
Dim arr()
ReDim arr(1 To NumQuarters, 1 To 1)
For q = 1 To NumQuarters 'Loop for the number of quarters
arr(q, 1) = wbkTxt.Sheets(1).Cells(11 + q, 2 + _
NumQuarters - q).Value
Next q
rng.Value = arr
'Close the text file
wbkTxt.Close
End With

Alan Beban

Geoff wrote:
I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?

Thanks in advance