If TextBox2.Value = "" Or TextBox3.Value = "" Or TextBox2.Value = "" And
TextBox3.Value = "" Then
Label4.Caption = "Please check your date entries and try again."
Exit Sub
End If

sheets("sheet3").Select
Range("A1").Select
Application.ScreenUpdating = False
Dim date1, date2, firsttwodigitsofdate1, firsttwodigitsofdate2,
usersname, mid2digitsofdate1, mid2digitsofdate2,
howevermanyworkbooksareopen, lasttwodigitsofdate1,
lasttwodigitsofdate2, 'filenamewillbe
date1 = TextBox2.Value
date2 = TextBox3.Value

firsttwodigitsofdate1 = Left(date1, 2)
firsttwodigitsofdate2 = Left(date2, 2)

mid2digitsofdate1 = Mid(date1, 3, 2)
mid2digitsofdate2 = Mid(date2, 3, 2)

lasttwodigitsofdate1 = Mid(date1, 5, 2)
lasttwodigitsofdate2 = Mid(date2, 5, 2)

While Len(ActiveCell.Value) 0 And firsttwodigitsofdate1 <=
firsttwodigitsofdate2
firsttwodigitsofdate1 = firsttwodigitsofdate1 + 0
firsttwodigitsofdate2 = firsttwodigitsofdate2 + 0

usersname = ActiveCell.Value 'this is a range of about 140 usernames in
a column

On Error Resume Next 'for when the workbook doesn't exist

Workbooks.Open ("P:\clevedon staff\activities\" & usersname & "\" &
usersname & " " & firsttwodigitsofdate1 & mid2digitsofdate1 &
midtwodigitsofdate2 & lasttwodigitsofdate1 & " activitylog.csv")

Workbooks(1).Activate
ActiveCell.Offset(1, 0).Select
If firsttwodigitsofdate1 firsttwodigitsofdate2 Then
Exit Sub
End If

If ActiveCell.Value = Empty Then
Range("A1").Select
firsttwodigitsofdate1 = firsttwodigitsofdate1 + 1
End If

Wend
'Next i
sheets("reports").Select
Label4.Caption = "Reports for the range " & TextBox2.Value & " to " &
TextBox3.Value & " generated on " & Now & "."
CommandButton9.Enabled = False
Call populate

End Sub

Sub populate()

Application.ScreenUpdating = True
Workbooks(1).Activate
sheets("reports").Select
Dim MyCell As Range
Dim Wb As Workbook
Dim MyFormula As String
Dim currcell
Dim mystr

Set MyCell = ThisWorkbook.sheets("reports").Range("B2")

For Each Wb In Workbooks

If Wb.Name < ThisWorkbook.Name Then

MyFormula = MyFormula & "'" & Wb.Name & "'" & "!R2C2" & ","

End If

Next Wb

MyCell.FormulaR1C1 = "=SUM(" & Left(MyFormula, Len(MyFormula) - 1) &
")"

Call finds

End Sub

Sub finds()

Application.ScreenUpdating = True
Workbooks(1).Activate
sheets("reports").Select

Range("B2").Select

Cells.Find(What:="$", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
Activate

Cells.Replace What:="$", Replacement:="", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False

Selection.AutoFill Destination:=Range("B2:B25"),
Type:=xlFillDefault

Range("B2:B25").Select

Selection.AutoFill Destination:=Range("B2:H25"),
Type:=xlFillDefault
sheets("reports").Range("A30").Select

ActiveCell.Value = UserForm1.TextBox2.Value & " " & "to" & " " &
UserForm1.TextBox3.Value



Call closetherest

End Sub

Sub closetherest()
'UserForm1.Hide
On Error Resume Next
sheets("reports").Select
Dim Wb As Workbook
Dim AWb As String
AWb = ActiveWorkbook.Name

For Each Wb In Workbooks
If Wb.Name < AWb Then
Wb.Close
End If
Next Wb
Application.ScreenUpdating = True
Range("B2:H25").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
sheets("reports").Range("A28").Value = "Date Range: " & TextBox2.Value
& " " & TextBox3.Value


End Sub

THe prob I get is that if I open a date range of more than ten days it
doesn't bring it in! All the workbooks will open, but the formula
doesn't rack up. But if theres only about 5 files to open it seems to
work fine.

Any ideas?
Cheers


--
Joseph


------------------------------------------------------------------------
Joseph's Profile: http://www.excelforum.com/member.php...fo&userid=5637
View this thread: http://www.excelforum.com/showthread...hreadid=320579