Vba needed: Saving over orginial file

[bamaisgreat]

I have a macro that saves my workbook as the current date and time. After that a different user opens the workbook and runs a macro that saves it,keeping the date and time as the first macro and then adds some additional text to the file name. The problem i have is that I now have 2 files that are identical but with different file names. I need the first one to be saved over or deleted. The code below is the 2nd macro that is used...

Sub FINALIZED_BY_QC()

Dim newFileName As String
Dim appendText As String
Dim pass As String
pass = "bama"  'Change this to whatever your password needs to be
If Not InputBox("Enter Password", "Password") = pass Then Exit Sub
With ActiveSheet
.Unprotect
With .Range("J24").Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
appendText = "-FINALIZED BY QC"
.Range("J24").FormulaR1C1 = appendText

    Range("A1:U23").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$U$23"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&Z&F&F&D&T"
        .LeftMargin = Application.InchesToPoints(1)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = False
        .PrintQuality = 300
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaper11x17
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = True
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = False
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveSheet.PageSetup.PrintArea = "$A$1:$U$23"
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        
    
    
.UsedRange.Locked = True
.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
newFileName = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".xls") - 1) & appendText
ActiveWorkbook.Save Filename:=newFileName, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Save
End Sub

 

[Jerry Sullivan]

Try replacing this part of your code:

newFileName = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".xls") - 1) & appendText
ActiveWorkbook.Save Filename:=newFileName, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Save

With this...

With ActiveWorkbook
    oldFileName = .FullName
    newFileName = Left(.FullName, InStrRev(.FullName, ".xls") - 1) _
        & appendtext
    .SaveAs Filename:=newFileName
End With
Kill oldFileName

 

[bamaisgreat]

Thanks Jerry it worked perfect. I wish I new how to write VBA its amazing.