When attempting to run macro Excel opens different workbook
 

Hi,

I've posted my code below. I have a toolbar that I created that runs two
functions contained in a module in an Excel 2002 workbook. When I ran the
procedures I did a 'save as' and renamed the current workbook and closed it.
I then reopened the original workbook and attempted to run the same two
procedures but for some reason everytime I attempt to run these Excel opens
the new 'saved as' version of the workbook and runs then runs the
procedures. Can anyone tell me why the other saved workbook is opening when
I run this code? The code is also in the newer saved version - I don't know
what this has to do with it though since the file is closed when I run the
code - any help would be appreciated. Also, this code worked fine when I ran
it from two command buttons but the problems began when I started running it
from a custom toolbar. I have to use a toolbar so buttons aren't an option

code:
Sub Openimportfile()

On Error GoTo import_err

fname = Application.GetOpenFilename(Title:="Select a File to Import",
MultiSelect:=False)

If fname < False Then

Set mybook = Workbooks.Open(Filename:=fname)

Set r = mybook.Worksheets(1).Columns("A").Cells

For Each c In r.Cells

'grab title
If Left(c.Value, 5) = "TI -" Then

strTitle = Trim(Right(c.Value, Len(c.Value) - 5))
Set nextCell = c.Offset(1, 0)

Do While Mid(nextCell.Value, 5, 1) < "-"

strTitle = strTitle & " " & Trim(nextCell.Value)
Set nextCell = nextCell.Offset(1, 0)

Loop

If Right(strTitle, 1) = "." Then strTitle = Left(strTitle,
Len(strTitle) - 1)
If strTitle = "" Then strTitle = "N/A"

Set rTitle = ThisWorkbook.Worksheets(1).Columns("A").Cells

For Each ctitle In rTitle.Cells

If ctitle.Value = "" Then
currRow = ctitle.Row
ctitle.Value = strTitle
Exit For
End If

Next

End If

'grab Address
If Left(c.Value, 5) = "AD -" Then

strAddress = Trim(Right(c.Value, Len(c.Value) - 5))
Set nextADCell = c.Offset(1, 0)

Do While Mid(nextADCell.Value, 5, 1) < "-"

strAddress = strAddress & " " & Trim(nextADCell.Value)
Set nextADCell = nextADCell.Offset(1, 0)

Loop

'grab email
lemail = InStr(strAddress, "@")
If lemail 0 Then

lemail = lemail - 1
For i = lemail To 1 Step -1

If Mid(strAddress, i, 1) = " " Then Exit For

strEmail = Right(strAddress, Len(strAddress) - (i -
1))

Next

strAddress = Left(strAddress, Len(strAddress) -
Len(strEmail))
End If

strRange = "B" & ctitle.Row
Set raddress = ThisWorkbook.Worksheets(1).Range(strRange)
raddress.Value = strAddress

strRange = "C" & ctitle.Row
Set rEmail = ThisWorkbook.Worksheets(1).Range(strRange)
rEmail.Value = strEmail


End If

'grab Name
If Left(c.Value, 5) = "FAU -" Then

Set prevCell = c.Offset(-1, 0)

If (Left(prevCell.Value, 5) < "FAU -" And Left(prevCell.Value,
5) < "AU -") Then

strname = Trim(Right(c.Value, Len(c.Value) - 5))
strFirstName = Right(strname, Len(strname) - InStr(strname,
","))
strLastName = Left(strname, InStr(strname, ",") - 1)

strRangeFirst = "D" & ctitle.Row
strRangeLast = "E" & ctitle.Row

Set rFirstName =
ThisWorkbook.Worksheets(1).Range(strRangeFirst)
Set rLastName =
ThisWorkbook.Worksheets(1).Range(strRangeLast)
rFirstName.Value = Trim(strFirstName)
rLastName.Value = Trim(strLastName)

End If

End If

'grab Journal
If Left(c.Value, 5) = "TA -" Then

strJournal = Trim(Right(c.Value, Len(c.Value) - 5))
strRange = "F" & ctitle.Row
Set rJournal = ThisWorkbook.Worksheets(1).Range(strRange)
rJournal.Value = strJournal

End If

strTitle = ""
strFirstName = ""
strLastName = ""
strAddress = ""
strEmail = ""
strJournal = ""

Next

mybook.Close

ActiveWorkbook.Save
MsgBox "Import Complete."
End If

Exit Sub
import_err:
MsgBox Err.Description
Exit Sub
End Sub

Public Sub ClearData()

On Error GoTo ClearData_err

Cells.Select
Selection.ClearContents

ThisWorkbook.Worksheets(1).Range("A1").Value = "Title"
ThisWorkbook.Worksheets(1).Range("B1").Value = "Address"
ThisWorkbook.Worksheets(1).Range("C1").Value = "Email"
ThisWorkbook.Worksheets(1).Range("D1").Value = "First Name"
ThisWorkbook.Worksheets(1).Range("E1").Value = "Last Name"
ThisWorkbook.Worksheets(1).Range("F1").Value = "Journal"

ActiveWorkbook.Save

Exit Sub
ClearData_err:
MsgBox Err.Description
Exit Sub
End Sub