View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
cphenley[_2_] cphenley[_2_] is offline
external usenet poster
 
Posts: 1
Default Date change macro between worksheets

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/