Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
when opening an Excel Workbook, another blank workbook also opens Gord Dibben Excel Discussion (Misc queries) 0 October 12th 07 09:49 PM
when opening an Excel Workbook, another blank workbook also opens spmu Excel Discussion (Misc queries) 0 October 12th 07 01:46 PM
Personal workbook opens when Excel opens SheriTingle Excel Discussion (Misc queries) 2 March 30th 05 12:22 AM
Excel crashes when attempting to open workbook...even with macros disabled llowwelll[_10_] Excel Programming 1 May 24th 04 09:38 PM
Run Macro when workbook opens Jean-Paul Viel Excel Programming 0 August 28th 03 08:59 PM


All times are GMT +1. The time now is 09:11 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"