Hi Alan,

Here's a listing of the code - it hasn't had much refinement yet, but
it should illustrate the problem. Basically, it stores a directory
listing in a worksheet, then sets up a link to each of those files to
test whether it falls within a certain date, and if it does, extract
some data for a report

Restating the problem - every time I run the macro, and do a save, the
file gets a bit larger, by about 4k. If I re-open it, and do a save
without running the macro, it drops back to its original size, about
56k. So, it seems I'm Ok until it hits a critical size, and then I
can't open it any more. That seems to be about 72k, and takes about
10 runs in succession, then a save, to produce that. I'd be extremely
grateful for any help on this.
Regards

DaveU


Option Explicit

Dim rng1 As Range, Cell1 As Range, RowCnt As Integer
Public dt1 As Date, dt2 As Date
Dim wk1 As Worksheet, wk2 As Worksheet, wk3 As Worksheet
Dim X As Long, Y As Long, Z As Long
Const MyPath As String = "C:\Documents and Settings\Dave\Desktop
\NewTom\"

Sub EntryMain()
Set wk1 = Worksheets("Report")
Set wk2 = Worksheets("Selected")
Set wk3 = Worksheets("List")

wk1.Cells.ClearContents
wk2.Cells.ClearContents
wk3.Cells.ClearContents:

Application.ScreenUpdating = False

Call DirList 'get listing of files
Call Selected 'select files that fall between dates
Call GetReport 'get results

Application.ScreenUpdating = True
End Sub

Sub Selected()
Dim str As String

wk3.Activate
Set rng1 = Intersect(Columns(1), ActiveSheet.UsedRange)
dt1 = "10/4/6": dt2 = "1/31/07"
RowCnt = 1
wk2.Activate
For Each Cell1 In rng1
str = "= '" & MyPath & "[" & Cell1.Text & "]Sheet1'"
Cells(RowCnt, 2).Formula = str & "!C4" 'date
If Cells(RowCnt, 2) = dt1 And Cells(RowCnt, 2) _
<= dt2 Then
Cells(RowCnt, 1) = Cell1.Text 'file name
Cells(RowCnt, 3).Formula = str & "!B38" 'cars count
RowCnt = RowCnt + 1
Else
Cells(RowCnt, 2) = "" 'not this file
End If
Next Cell1
End Sub

Sub GetReport()

wk2.Activate

If Range("A1") = "" Then MsgBox "No files found meeting search
criteria . . .": Exit Sub

Set rng1 = Intersect(Columns(3), ActiveSheet.UsedRange)
X = Application.Sum(rng1)

wk1.Cells(1, 1) = "Report for " & dt1 & " to " & dt2
wk1.Cells(3, 1) = "Total Cars ="
wk1.Cells(3, 3) = X

wk1.Activate
'cleanup
wk2.Cells.Clear
wk3.Cells.Clear

End Sub

Sub DirList()
Dim r As Long, direct As String, F As String

wk3.Activate
r = 1
direct = MyPath & "STR*.xls" 'MyPath in declarations
F = Dir(direct)
Cells(r, 1) = F
Do While F < ""
F = Dir
If F < "" Then
r = r + 1
Cells(r, 1) = F
End If
Loop
End Sub

On Jan 31, 2:27 pm, Alan wrote:
Hi Dave,

Posting your code would help would address any code issues you might have
that could be causing the problem.

Alan

"The only dumb question is a question left unasked."