Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
when opening an Excel Workbook, another blank workbook also opens | Excel Discussion (Misc queries) | |||
when opening an Excel Workbook, another blank workbook also opens | Excel Discussion (Misc queries) | |||
Personal workbook opens when Excel opens | Excel Discussion (Misc queries) | |||
Excel crashes when attempting to open workbook...even with macros disabled | Excel Programming | |||
Run Macro when workbook opens | Excel Programming |