fern
07-01-2005, 03:29 PM
Hi.
I've got this complex macro that WAS working perfectly but now stalls each time I run it. The annoying thing is that the code DOES work: if I insert a breakpoint over the "Next" statement (or even at the "Save") and only let it run one full loop at a time, then it works just fine and will run to completion (so long as I'm patient enough to loop it through by hand over & over). But since I need this thing to loop 73 times each time I run it (and each of those loops involves doing thousands of smaller loops), I'd rather find out what's going wrong & fix it, instead of spending my whole summer looping it all by hand..
So here's the code (including all the lead-in bits so you'll have as much info as possible):
Option Explicit
Option Base 1
Public SourceFile As Variant, SummaryFile As Workbook, Response, ResponseBool As Boolean, Row As Long
Public Sub SummariseBlossom()
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder") 'otherwise it's slow
If Response = vbNo Then
Exit Sub
Else
ResponseBool = True
Call ImportAndReformat
Call SummarisingResults
Set SummaryFile = Nothing
End If
MsgBox "All Done!"
End Sub
Private Sub ImportAndReformat()
Dim ResultStr As String, sFileName As String, FileNum As Integer, Counter As Double, FileNameArr As Variant
Dim ResultsWB As Workbook, Response As Integer, lngCount As Long, NextResponse, shtCount As Double
Dim Rng As Range, WS As Worksheet, c As Range, SummaryWB As Workbook, ssCount As Double
Dim FirstAddress As String, MyArr As Variant, Rcount As Long, i As Long, AllCaps As String
Dim l As Long, lStart As String, Skip As Long, pos As Long, f As Long
Dim SUBFileNum As Integer, SourceStr As String, SUBSource As String, SUBFile As Variant, SUBHyp As String, Hyp As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ResponseBool = False Then
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder")
If Not Response = vbYes Then
Exit Sub
End If
End If
ChDir "C:\Results"
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "Blossom Output", "*.txt", 1
.Filters.Add "All Files", "*.*"
.Title = "Choose which T-Statistic Source File(s) to summarise"
.Show
End With
FileNum = FreeFile()
ssCount = 0
Set SummaryFile = Workbooks.Add(template:=xlWorksheet)
SummaryFile.Activate
SummaryFile.SaveAs Filename:=Application.GetSaveAsFilename(SourceFile, "Excel Workbooks(*.xls), *.xls", _
, "Choose a one-word name for the Summary workbook")
'***************HERE'S WHERE THE TROUBLESOME LOOP STARTS:***********
For f = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
SourceFile = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(f)
FileNameArr = Split(CStr(SourceFile), "\", 7)
shtCount = 1
Open SourceFile For Input As #FileNum
If Not f = 1 Then
SummaryFile.Worksheets.Add After:=Worksheets(Worksheets.Count)
End If
SummaryFile.Worksheets(Worksheets.Count).Name = "T_File" & f
Counter = 1
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importing Row " & Counter & " of output file " & SourceFile
Line Input #FileNum, ResultStr
If Left$(UCase(ResultStr), 2) Like Left$(UCase(FileNameArr(UBound(FileNameArr) - 1)), 2) Then
Row = 1
If Not ActiveCell.Address = "$A$1" Then
ActiveCell.Offset(1 - ActiveCell.Row, 1).Select
If ActiveCell.Column = 220 Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Range(Cells(1, 1), Cells(1, 251)).Font.Bold = True
shtCount = shtCount + 1
Worksheets(Worksheets.Count).Name = "T_File" & f & "#" & shtCount
Cells(1, 1).Select
End If
End If
ssCount = ssCount + 1
ActiveCell.Value = "ss" & ssCount
Else
Row = Row + 1
ActiveCell.Value = ResultStr
End If
ActiveCell.Offset(1, 0).Select
Counter = Counter + 1
Loop
Close
Next f '<=== CODE WORKS FINE IF BREAKPOINT IS PUT HERE!!
SummaryFile.Save '<=== OR EVEN HERE
'...the macro carries on - but that part works a-ok
Can anyone see why this is stalling? I've run out of ideas & can't even debug b/c the code DOES officially work... :huh:
Hope someone can help... Thx
I've got this complex macro that WAS working perfectly but now stalls each time I run it. The annoying thing is that the code DOES work: if I insert a breakpoint over the "Next" statement (or even at the "Save") and only let it run one full loop at a time, then it works just fine and will run to completion (so long as I'm patient enough to loop it through by hand over & over). But since I need this thing to loop 73 times each time I run it (and each of those loops involves doing thousands of smaller loops), I'd rather find out what's going wrong & fix it, instead of spending my whole summer looping it all by hand..
So here's the code (including all the lead-in bits so you'll have as much info as possible):
Option Explicit
Option Base 1
Public SourceFile As Variant, SummaryFile As Workbook, Response, ResponseBool As Boolean, Row As Long
Public Sub SummariseBlossom()
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder") 'otherwise it's slow
If Response = vbNo Then
Exit Sub
Else
ResponseBool = True
Call ImportAndReformat
Call SummarisingResults
Set SummaryFile = Nothing
End If
MsgBox "All Done!"
End Sub
Private Sub ImportAndReformat()
Dim ResultStr As String, sFileName As String, FileNum As Integer, Counter As Double, FileNameArr As Variant
Dim ResultsWB As Workbook, Response As Integer, lngCount As Long, NextResponse, shtCount As Double
Dim Rng As Range, WS As Worksheet, c As Range, SummaryWB As Workbook, ssCount As Double
Dim FirstAddress As String, MyArr As Variant, Rcount As Long, i As Long, AllCaps As String
Dim l As Long, lStart As String, Skip As Long, pos As Long, f As Long
Dim SUBFileNum As Integer, SourceStr As String, SUBSource As String, SUBFile As Variant, SUBHyp As String, Hyp As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ResponseBool = False Then
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder")
If Not Response = vbYes Then
Exit Sub
End If
End If
ChDir "C:\Results"
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "Blossom Output", "*.txt", 1
.Filters.Add "All Files", "*.*"
.Title = "Choose which T-Statistic Source File(s) to summarise"
.Show
End With
FileNum = FreeFile()
ssCount = 0
Set SummaryFile = Workbooks.Add(template:=xlWorksheet)
SummaryFile.Activate
SummaryFile.SaveAs Filename:=Application.GetSaveAsFilename(SourceFile, "Excel Workbooks(*.xls), *.xls", _
, "Choose a one-word name for the Summary workbook")
'***************HERE'S WHERE THE TROUBLESOME LOOP STARTS:***********
For f = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
SourceFile = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(f)
FileNameArr = Split(CStr(SourceFile), "\", 7)
shtCount = 1
Open SourceFile For Input As #FileNum
If Not f = 1 Then
SummaryFile.Worksheets.Add After:=Worksheets(Worksheets.Count)
End If
SummaryFile.Worksheets(Worksheets.Count).Name = "T_File" & f
Counter = 1
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importing Row " & Counter & " of output file " & SourceFile
Line Input #FileNum, ResultStr
If Left$(UCase(ResultStr), 2) Like Left$(UCase(FileNameArr(UBound(FileNameArr) - 1)), 2) Then
Row = 1
If Not ActiveCell.Address = "$A$1" Then
ActiveCell.Offset(1 - ActiveCell.Row, 1).Select
If ActiveCell.Column = 220 Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Range(Cells(1, 1), Cells(1, 251)).Font.Bold = True
shtCount = shtCount + 1
Worksheets(Worksheets.Count).Name = "T_File" & f & "#" & shtCount
Cells(1, 1).Select
End If
End If
ssCount = ssCount + 1
ActiveCell.Value = "ss" & ssCount
Else
Row = Row + 1
ActiveCell.Value = ResultStr
End If
ActiveCell.Offset(1, 0).Select
Counter = Counter + 1
Loop
Close
Next f '<=== CODE WORKS FINE IF BREAKPOINT IS PUT HERE!!
SummaryFile.Save '<=== OR EVEN HERE
'...the macro carries on - but that part works a-ok
Can anyone see why this is stalling? I've run out of ideas & can't even debug b/c the code DOES officially work... :huh:
Hope someone can help... Thx