addin not running correctly

[sc]

I posted a question Friday and I got a response to post my code. I got all
of the code on the internet except for the lines at the end after the End If
statement and before the GoTo statement. Below is the original message I
posted:

I have created an addin in excel 2002. I load the addin through
tools>addins>browse. It then puts a menu item in the tools menu. I click on
the addin and the userform I created comes up and I hit the ok button on my
userform. It runs for about 30 seconds and then gives me an error. I
noticed I had a GoTo statement between a With and End With. So I cut
everything in the GoTo staement and put it outside the With staement and ran
it again. It ran correctly so I saved the addin file. I then closed excel
and tried to run it again. It did not give me an error message it just quit
running. So I went to the VBE and made sure the code was correct. It was
correct. So I then ran the addin again and it ran fine. It seems like after
a bad run the next one is a good run. Any suggestions to what is causing
this?


Here is the code:

Private Sub cmdsearch_Click()
Dim SubFolders As Boolean
Dim Fsbj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String, FileExt As String
Dim MyFiles() As String, Fnum As Long

Dim SourceRcount As Long, rnum As Long
Dim basebook As Workbook, mybook As Workbook
Dim sourceRange As Range, destrange As Range

'Loop through all files in the Root folder
RootPath = txtlookin.Text
'Loop Through the subfolder true or false
SubFolders = False
'Loop through files with this extension
FileExt = ".xls"

'Add a slash at the end if the user forgot it
If Right(RootPath, 1) <> "\" Then
RootPath = RootPath & "\"
End If

Set Fsbj = CreateObject("Scripting.FileSystemObject")
If Not Fsbj.folderexists(RootPath) Then
MsgBox RootPath & "Not Exist"
Exit Sub
End If

Set RootFolder = Fsbj.GetFolder(RootPath)

'Fill the array (myFiles) with the list of Excel files in the folders
Fnum = 0
'Loop through the files in the root folder
For Each file In RootFolder.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file

'Loop through the files in the sub folders if sub folders = true
If SubFolders Then
For Each SubFoldersInRoot In RootFolder.SubFolders
For Each file In SubFolderInRoot.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolderInRoot & "\" & file.Name
End If
Next file
Next SubFoldersInRoot
End If

'now we can open the files in the array MyFiles to do what we want
On Error GoTo CleanUp
Application.ScreenUpdating = False


Set basebook = ThisWorkbook

'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Delete

'start row for the info from the first file
rnum = 1
'loop through all files in the array (MyFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))

Set sourceRange = mybook.Worksheets(1).Range("a1").CurrentRegion
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Range("A" & rnum)

'This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "F").Value = MyFiles(Fnum)

sourceRange.Copy destrange

rnum = rnum + SourceRcount

mybook.Close savechanges:=False
Next Fnum
End If

Set drange = ActiveWorkbook.Worksheets(1).Range("a1")
basebook.Worksheets(1).Range("A1").CurrentRegion.Copy drange

CleanUp:
Application.ScreenUpdating = True

End Sub