Macro runs several times, but later crashes - some overflow Problem?

[Reuel]

------------------------------------------------------------------------
A poll associated with this post was created, to vote and see the
results, please visit http://www.excelforum.com/showthread.php?threadid=467235
------------------------------------------------------------------------
Question: oops disregard

- Q
- Q
------------------------------------------------------------------------

Hi -

I have written an Excel macro that opens multiple text data files, then
copies and formats the data in individal sheets in a workbook. The macro
runs fine for the first several text files (open/ copy/ close / format
data; repeat), but then hangs up after doing a few. The code often
hangs on a paste/select/delete command. The exact line that it hangs on
may vary, depending upon the input data file which can vary in length. A
common error message is

Run time error -2147417847 (80010108)
Automation error
The object invoked has disconnected from its clients

-OR-
Run time error -2147417847 (80010108)
Method of 'Range' failed

Since the code runs fine for the first few iterations, it seems as
though this is a problem with some overrun buffer in the Excel. One
suggestion that I have implemented, based on replies to similar posts,
is to use OPTION EXPLICIT to insure that all my variables are declared.
Another suggestion I have seen is to direct Excel very explicitly by
replacing more general Range(thisrange) commands with
ActiveSheet.Range(thisrange).

I would very much appreciate any suggestions for solving this very
frustrating problem, or for suggestions as to other resources that
might be available for solving these problems.

Thanks.
Code is below. Also, the workbook with sample data files is attached so
you could attempt an execution.
*********************************
Option Explicit
Sub Summarize()

Dim myDir, myFile, Message, mySheet, temp, ConversionFactor, tempA,
temp1, temp2, PasteRange As String
Dim i, j, number_of_files, myRow, namerow, myCheck,
Number_LI_DataPoints, StartComment As Integer
Dim X_Range, Wavelength, CommentRange, QE_Range As Range
Dim myWorkbook As Workbook

myRow = 3
namerow = 3
PasteRange = "A54" ' Range in template to paste the diode datafile

Set myWorkbook = ActiveWorkbook

'Run listfiles; finds files in the directory
number_of_files = ListFiles()
i = 1
ActiveSheet.Range("A3").Select
ActiveSheet.Range("A3", Selection.End(xlDown)).Select
number_of_files = Selection.Cells.Count
ActiveSheet.Range(Selection, Selection.Offset(0, 1)).Select
'Sort files alphabetically
Selection.Sort "Column A", xlDescending

'Inquire if correct files were grabbed; Warn if there are too many
files for Excel to handle
If number_of_files < 55 Then
myCheck = MsgBox("Do you wish to CONTINUE?", vbYesNo)
Else
Message = "Warning You Fool!" & Chr(13) & Chr(13) & _
"This program chokes if you have more than ~55
files." & Chr(13) _
& "You have " & number_of_files & "." & Chr(13) _
& "Do you wish to CONTINUE?"
myCheck = MsgBox(Message, vbYesNo)
End If

If myCheck = vbNo Then
deletefilenames
Exit Sub
End If

myFile = Cells(namerow, 1)
'**************************************
Do Until myFile = ""

ActiveSheet.Range("A1").Select
Sheets("Template").Select
Sheets("Template").Copy After:=Sheets(2)
mySheet = Left(myFile, Len(myFile) - 4) 'chop off .csv extension
and name sheet
Sheets("Template (2)").Name = mySheet

'Clear out old data
j = 0
Do While Not ActiveSheet.Range(PasteRange).Offset(j, 0).Value =
"Current(A)"
j = j + 1
Loop
ActiveSheet.Range(PasteRange).Select
ActiveSheet.Range(ActiveSheet.Range(PasteRange).Offset(j + 1, 0),
ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Clear 'ClearContents


'Open raw datafile and copy data into Extraction Template
Workbooks.OpenText Filename:=myFile
ActiveSheet.Range("A1",
ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
myWorkbook.Activate
Sheets(mySheet).Select
ActiveSheet.Range(PasteRange).PasteSpecial (xlPasteValues)
Workbooks(myFile).Activate
Application.CutCopyMode = False
Workbooks(myFile).Close SaveChanges:=False

'Find beginning of X data for L-I curve
j = 0
Do While Not ActiveSheet.Range(PasteRange).Offset(j, 0).Value =
"Current(A)"
j = j + 1
Loop
Set X_Range = ActiveSheet.Range(PasteRange).Offset(j + 1, 0)

'Find Wavelength
j = 0
Do While Not ActiveSheet.Range(PasteRange).Offset(j, 0).Value =
"WL(nm)"
j = j + 1
Loop
Set Wavelength = ActiveSheet.Range(PasteRange).Offset(j, 1)

'Convert data to mW and mA units
ActiveSheet.Range(X_Range, Selection.End(xlDown)).Select 'Find data
range
Number_LI_DataPoints = Selection.Cells.Count
ActiveSheet.Range(X_Range.Offset(0, 11),
X_Range.Offset(Number_LI_DataPoints, 12)).Select
Selection.Formula = "=" + X_Range.Address(False, False) + "*1000"
Selection.Copy
X_Range.PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

' Establish an additional data series for summary graph that has
offsets
ActiveSheet.Range(X_Range.Offset(0, 11),
X_Range.Offset(Number_LI_DataPoints, 11)).Select
temp = ActiveSheet.Range(PasteRange).Offset(-1, 7).Address(True,
False) 'X_Offset value
Selection.Formula = "=" + X_Range.Address(False, False) + "+" +
temp
ActiveSheet.Range(X_Range.Offset(0, 12),
X_Range.Offset(Number_LI_DataPoints, 12)).Select
temp = ActiveSheet.Range(PasteRange).Offset(-1, 8).Address(True,
False) 'Y_Offset value
Selection.Formula = "=" + X_Range.Offset(0, 1).Address(False,
False) + "+" + temp

'Calculate QE data series and Avg QE data series
Set QE_Range = X_Range.Offset(1, 13)
ConversionFactor = "100 * 6.63E-34 * 300000000 / (" &
Wavelength.Address & " * 0.000001) / 1.6E-19"
QE_Range.Formula = "=(" & QE_Range.Offset(0, -1).Address(False,
False) & _
"-" & QE_Range.Offset(-1, -1).Address(False,
False) & _
")/(" & QE_Range.Offset(0, -2).Address(False,
False) & _
"-" & QE_Range.Offset(-1, -2).Address(False,
False) & _
")*" & ConversionFactor
QE_Range.Resize(5).Select
QE_Range.AutoFill Destination:=QE_Range.Resize(5),
Type:=xlFillDefault

QE_Range.Offset(4, 1).Formula = "=Average(" &
QE_Range.Resize(5).Address(False, False) & ")"
QE_Range.Offset(4, 0).Resize(Number_LI_DataPoints - 5, 2).Select
QE_Range.Offset(4, 0).Resize(1, 2).AutoFill Destination:= _
QE_Range.Offset(4, 0).Resize(Number_LI_DataPoints - 5, 2),
Type:=xlFillDefault

Application.CutCopyMode = False

'Rename chart, adjust length of data series
ActiveSheet.ChartObjects("Chart 1").Activate

tempA = "=" & mySheet & "!" &
X_Range.Resize(Number_LI_DataPoints).Address(, , xlR1C1)
temp1 = "=" & mySheet & "!" & X_Range.Offset(0,
1).Resize(Number_LI_DataPoints).Address(True, True, xlR1C1)
temp2 = "=" & mySheet & "!" & X_Range.Offset(0,
14).Resize(Number_LI_DataPoints).Address(True, True, xlR1C1)
With ActiveChart
..HasTitle = True
..ChartTitle.Characters.Text = mySheet &
ActiveSheet.Range(PasteRange).Offset(1, 1) 'Diode number
..SeriesCollection(1).XValues = tempA 'Current
..SeriesCollection(1).Values = temp1
..SeriesCollection.NewSeries
..SeriesCollection(2).Name = "QE"
..SeriesCollection(2).XValues = tempA
..SeriesCollection(2).Values = temp2 'Avg QE
End With

'Copy chart and summary data to summary page
ActiveSheet.Range(PasteRange).Offset(-1, 5).Resize(1, 10).Copy
Sheets("Summary").Select
ActiveSheet.Range("C31").PasteSpecial Paste:=xlPasteValues

temp1 = "=" & mySheet & "!" & X_Range.Offset(0,
11).Resize(Number_LI_DataPoints).Address(, , xlR1C1)
temp2 = "=" & mySheet & "!" & X_Range.Offset(0,
12).Resize(Number_LI_DataPoints).Address(, , xlR1C1)
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Select
With ActiveChart
..SeriesCollection.NewSeries
..SeriesCollection(i).XValues = temp1
..SeriesCollection(i).Values = temp2
..SeriesCollection(i).Name = mySheet & "(" & Range(mySheet & "!"
& PasteRange).Offset(1, 1) & ")"
End With

' Make offsets dynamic from Summary sheet
ActiveSheet.Range("e31:f31").Copy
Sheets(mySheet).Select
ActiveSheet.Range(PasteRange).Offset(-1, 7).Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False

'Copy comments j = 0
Do While Not ActiveSheet.Range(PasteRange).Offset(j, 0).Value =
"Current(A)"
If ActiveSheet.Range(PasteRange).Offset(j, 0).Value =
"Comments" Then
StartComment = j
End If
j = j + 1
Loop
Set CommentRange =
ActiveSheet.Range(ActiveSheet.Range(PasteRange).Offset(StartComment,
1), ActiveSheet.Range(PasteRange).Offset(j - 1, 1))
'Now, write comment lines to box
ActiveSheet.Shapes("Text Box 2").Select
Selection.Characters.Text = "Comment/Description: " &
CommentRange.Cells(1)
For j = 2 To CommentRange.Cells.Count
Selection.Characters.Text = Selection.Characters.Text & Chr(10)
& CommentRange.Cells(j).Offset(0, -1)
Next j
Selection.Characters(Start:=1, Length:=21).Font.FontStyle = "Bold"
'Bold the heading, Comment/Description
ActiveSheet.Range("C9").Select

'Return to summary sheet
Sheets("Summary").Select

ActiveSheet.Range("C30:m30").Select
Selection.Insert Shift:=xlDown

'''''''''''''''''''''''''''''''

i = i + 1
namerow = namerow + 1

myFile = Cells(namerow, 1)

Loop

ActiveSheet.Range("C29").Value = ActiveSheet.Range("C32")
AddTitle
myWorkbook.SaveAs Filename:=CurDir & "\" &
Range("'Summary'!C29").Value & " L-I Summary"

End Sub


+-------------------------------------------------------------------+
|Filename: ProblemWorkbook.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3816 |
+-------------------------------------------------------------------+

 

[Reuel]

This problem is addressed fully in a new thread titled, "Where else to get
help?"
-Reuel