Home |
Search |
Today's Posts |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks for the help, but I haven't been able to successfully implement
your suggestions. My main problem is that I can't define the names of the two workbooks as suggested because they change every time the program is run. I think posting the code is easier than an explination, I apologize for the excess: Sub SelectNewFile() Dim NewFileName As String, OldFileName As String, Fdate As String, NewName As String Dim OldName As String, awb As Workbook, BackupFileName As String, i As Integer Dim OK As Boolean, astrLinks As Variant, iCtr As Long, NewW As String If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub Set awb = ActiveWorkbook If awb.Path = "" Then Application.Dialogs(xlDialogSaveAs).Show Else BackupFileName = awb.Name OK = False On Error GoTo NotAbleToSave If Dir("I:\Pyro-Process reports\SIC-2\" & BackupFileName) < "" Then Kill "I:\Pyro-Process reports\SIC-2\" & BackupFileName End If With awb Application.StatusBar = "Saving this workbook..." Save Application.StatusBar = "Saving this workbook backup..." SaveCopyAs "I:\Pyro-Process reports\SIC-2\" & BackupFileName OK = True End With End If NotAbleToSave: Set awb = Nothing Application.StatusBar = False If Range("B4").Value = "" Then Range("B4").Value = InputBox("Please enter the new date", "Date") Else Range("B4").Value = Range("B4").Value + 1 End If Range("B4").NumberFormat = "mm-dd-yy;@" Fdate = Format(Range("B4"), "mm_dd_yy") NewFileName = "SIC_2-" & Fdate & ".xls" ' Define variable as an Excel link type. astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks) If IsArray(astrLinks) Then For iCtr = LBound(astrLinks) To UBound(astrLinks) ActiveWorkbook.BreakLink _ Name:=astrLinks(iCtr), _ Type:=xlLinkTypeExcelLinks Next iCtr End If Set awb = ActiveWorkbook ' Open new file Workbooks.Open "I:\Pyro-Process reports\SIC-2\template.xls" - NewW = "template.xls" Workbooks(NewW).Worksheets(1).Range("B4").Value = _ Workbooks(BackupFileName).Worksheets(1).Range("B4" ).Value 1 - ' Save as new file using date ActiveWorkbook.SaveAs "I:\Pyro-Process reports\SIC-2\" & NewFileName ' Close old file awb.Close SaveChanges:=True Calculate End Sub Hopefully that explains what I am trying to do better than I can describe. If anyone can explain or show me how to implement the date change, I would be very grateful. Thanks. --- Message posted from http://www.ExcelForum.com/ |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Macro to Change Footer on all worksheets | Excel Discussion (Misc queries) | |||
how do I get a macro to change a cell in multiple worksheets? | Excel Discussion (Misc queries) | |||
Date Change Macro | Excel Worksheet Functions | |||
Macro to change worksheets in the same workbook | Excel Discussion (Misc queries) | |||
Macro to perform mass header change on 100 worksheets | Excel Programming |