When attempting to run macro Excel opens different workbook

  • Thread starter Thread starter Rasta
  • Start date Start date
R

Rasta

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
 
When you did a "Save-As" the references went to the new workbook.
And Didn't stay with the "old" workbook.

This is one of the "gothca's" when using "Save-As".

You have 2 choices
1. Move the "old" version to a save place, or
goto the explorer and change the name by adding "old" to the name
2. Open the new file and do as "Save-As" to the original name
3. Close Excel
4. Go back to explorer and
delete the newly saved file
5. Remove "old" from the name of the original file.

Than check to make sure it worked.

Other wise you'll just have to reassign all the macros...

This is a trap that used to catch me all the time...
And still does once in a while...
 
Thanks for the help. I went in and reassigned all of the macros. I also
noticed that if I change the name of the original excel file I have the
same problem in that it references the original name when trying to run
a macro. Is there any way around this?
 
The trick is to find out what workbook name is assigned to the macros.
Make a copy of the original workbook and change the name in the explorer
window.
(Open this workbook)
Make sure the workbook that you want is opened with that name.
Than save-as to the name you originally wanted.

It sounds tricky, but it is really a lot quicker than resetting all the
macros. Unless you just have
a couple. For me it would take hours to reset all my toolbar buttons.

What I should do is create my special toolbars from the workbook and than
never have to worry about it again...
 
Back
Top