Solved: Can't manage to rename updated version

[PEV]

I've fallen and I can't get up. The below is attached to a button that leads the user to another worksheet. I want the Macro to check for a newer version of the workbook (might have some programming changes, or some cosmetic changes) and Save the newer verion on the users desktop. So in steps, this is what i want to happen:

1. User opens the Workbook. There is a Query to another Workbook to update the Version number (Cell H47)
2. Checks User's version (cell H46) against H47
3. If H46 is smaller, opens "Master_SSI.xls" from a Network path
4. Close old version (SSI.xls) 'Up to here, all work perfectly

This is where is stops doing it's thing. I don't get an error message
5. At this point, "Master_SSI.xls" is open so I want to rename it "SSI.xls" and put it on the user's Desktop making it the updated version. But "Master_SSI" stays open instead.

What have i missed?


Sub GroupQQ_Click()
Dim ws As Worksheet
'check for newer version
If Range("h46") < Range("h47") Then
MsgBox "New Version available, one moment please"

Workbooks.Open "\\Network path...Forms\SSI_Master.xls (file://\\Network path...Forms\SSI_Master.xls)"
Workbooks("SSI.xls").Close Savechanges:=True

'this is where is stops. does not give error message, just does not proceed to next step which is renaming newer version onto user's desktop

Dim Fname As String

Application.DisplayAlerts = False

Fname = "C:\Documents and Settings\All Users\Desktop\" & "SSI" & ".xls"

ActiveWorkbook.SaveAs Fname

Application.DisplayAlerts = True
MsgBox ("New Version Saved to your Desktop")

Range("D10").Activate

End If

' this next part works fine

Application.ScreenUpdating = False
'Check for user info
If IsEmpty(Range("D10")) Then
MsgBox "Please enter your information"
Else
If Range("D10") = "" Then
MsgBox "Please enter your information"
ElseIf Range("D10").HasFormula Then
MsgBox "Please enter your information"
End If
If Range("D10") > 1 Then
End If

Sheets("QQ").Visible = True
Sheets("Version").Visible = xlVeryHidden
Sheets("Cover").Visible = xlVeryHidden
Sheets("RR").Visible = xlVeryHidden
Sheets("SOP").Visible = xlVeryHidden
Sheets("TT").Visible = xlVeryHidden
Sheets("OFFCL").Visible = xlVeryHidden
Sheets("EX").Visible = True
Worksheets("EX").Select
Columns("B:B").Select
Range("A1:J39").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("EX").Visible = xlVeryHidden
Range("C4").Select
Application.ScreenUpdating = True
End If
End Sub

[CatDaddy]

rename workbook before close not after?

[PEV]

I guess?
Start from SSI
Open Master
Close SSI (older version)
Rename Master as SSI (will become new version of SSI)

[PEV]

I've tried a bunch of combinations and still can't get it to save the downloaded version as the newest SSI.xls
Did I close my workbooks in the wrong order or put the SaveAs in the wrong spot?

[rcharters]

By setting "Application.DisplayAlerts = False" you do not see the popup message asking if you want to replace the current file.

Try using the "Kill" statement to delete the old file before saving the new one.

[frank_m]

Edit; My apologies, after further examination :devil2:, I see that my version is no good;
as it fails to update the SSI.xls with the Master. -- (I'll try to tinker with it more later)
Sub GroupQQ_Click()
Dim ws As Worksheet
'Edit: - Tested using Excel 2003
'(for me)using All Users causes a "can't saveas using same name as a file that is already open"error
'where as as using my specific user name works
Dim Fname As String: Fname = "C:\Documents and Settings\Frank\Desktop\SSI.xls"

'check for newer version
If Range("h46") < Range("h47") Then

MsgBox "New Version available, one moment please"

Workbooks.Open "\\Network path...Forms\SSI_Master.xls"""

Application.DisplayAlerts = False

'Use ThisWorkbook instead of ActiveWorkbook to avoid naming error
ThisWorkbook.SaveAs Fname

Application.DisplayAlerts = True

MsgBox ("New Version Saved to your Desktop")

End If

Workbooks("Master_SSI.xls").Close Savechanges:=False

End Sub

[PEV]

I've changed a few things but still end up with SSI_Master open and an unchanged SSI on the desktop



Dim ws As Worksheet
Dim Fname As String: Fname = "C:\Documents and Settings\All Users\Desktop\SSI.xls"
If Range("h46") < Range("h47") Then

MsgBox "New Version available, one moment please"

Workbooks.Open "\\Network path\Operations\Quotes\Quote (file://\\Network path\Operations\Quotes\Quote) Forms\SSI_Master.xls"

Workbooks("SSI.xls").Close SaveChanges:=True

ThisWorkbook.SaveAs Fname

MsgBox ("New Version Saved to your Desktop")

Workbooks("SSI_Master.xls").Close SaveChanges:=False

End If

[frank_m]

Yeah, sorry for the false hope. - same result as yours is true here and I'm too busy for the next day or two to try to figure out a solution..

- Hope someone more knowlegable than me will step in and work this out.

[PEV]

Thanks Frank. No false hopes here and lots of appreciation. Will continue to work on it. It's gotta be something about the order of events. Still owe you a beer for the efforts

[PEV]

I think I've found a solution. It's kinda messy so if anyone has any bright ideas to clean it up (user has to press the button twice. Once to get the new version, once to rename it) it would be apreciated.

Frank: thanks a bunch. Got me thinking
Rcharters: too new at this and kinda got scared reading up on Kill but I like the idea to delete the old versions. will play around it fo sho


Sub GroupQQ_Click()

Dim ws As Worksheet

'check for newer version
If Range("h46") < Range("h47") Then

MsgBox "New Version available, one moment please"

Workbooks.Open "\\Network Path\Operations\Quotes\Quote (file://\\Network Path\Operations\Quotes\Quote) forms\SSI_Master.xls"

Application.DisplayAlerts = False

Workbooks("SSI.xls").Close SaveChanges:=False

Application.DisplayAlerts = True

MsgBox ("New Version Saved to your Desktop")

' will try to put the renaming part here
ElseIf Range("H46") = Range("H47") Then

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\All Users\Desktop\SSI.xls"

Application.DisplayAlerts = True


End If



'Check for user info
If IsEmpty(Range("D10")) Then

MsgBox "Please enter your information"

Else

If Range("D10") = "" Then
MsgBox "Please enter your information"
ElseIf Range("D10").HasFormula Then
MsgBox "Please enter your information"
End If
If Range("D10") > 1 Then
End If

Application.ScreenUpdating = False

Sheets("QQ").Visible = True
Sheets("Version").Visible = xlVeryHidden
Sheets("Cover").Visible = xlVeryHidden
Sheets("RR").Visible = xlVeryHidden
Sheets("SOP").Visible = xlVeryHidden
Sheets("TT").Visible = xlVeryHidden
Sheets("OFFCL").Visible = xlVeryHidden
Sheets("EX").Visible = True
Worksheets("EX").Select
Columns("B:B").Select
Range("A1:J39").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("EX").Visible = xlVeryHidden
Range("C4").Select
Application.ScreenUpdating = True
End If
End Sub

[mancubus]

maybe assigning the desktop address to a variable will do the trick.


Sub SaveToDesktop()
'source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=216

Dim DTAddress As String
DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator

ActiveWorkbook.SaveAs DTAddress & "SSI.xls"

End Sub

[PEV]

Maybe I've been at this too long today. Where do i go stick that?

[PEV]

Mancubus: Tell me more about this "desktop to a variable" thing of yours. I just found an issue with the below line because some of my users have Windows in French so the path that i used to save will be different


ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\All Users\Desktop\SSI.xls"

[mancubus]

thread has been marked as solved. so i assumed it's been solved.

re to post #10.


Sub GroupQQ_Click()

Dim ws As Worksheet
Dim DTAddress As String

DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator


'check for newer version
If Range("h46") < Range("h47") Then

MsgBox "New Version available, one moment please"

Workbooks.Open "\\Network Path\Operations\Quotes\Quote forms\SSI_Master.xls"

Application.DisplayAlerts = False

Workbooks("SSI.xls").Close SaveChanges:=False

Application.DisplayAlerts = True

MsgBox ("New Version Saved to your Desktop")

' will try to put the renaming part here
ElseIf Range("H46") = Range("H47") Then

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs DTAddress & "SSI.xls"

Application.DisplayAlerts = True


End If



'Check for user info
If IsEmpty(Range("D10")) Then

MsgBox "Please enter your information"

Else

If Range("D10") = "" Then
MsgBox "Please enter your information"
ElseIf Range("D10").HasFormula Then
MsgBox "Please enter your information"
End If
If Range("D10") > 1 Then
End If

Application.ScreenUpdating = False

Sheets("QQ").Visible = True
Sheets("Version").Visible = xlVeryHidden
Sheets("Cover").Visible = xlVeryHidden
Sheets("RR").Visible = xlVeryHidden
Sheets("SOP").Visible = xlVeryHidden
Sheets("TT").Visible = xlVeryHidden
Sheets("OFFCL").Visible = xlVeryHidden
Sheets("EX").Visible = True
Worksheets("EX").Select
Columns("B:B").Select
Range("A1:J39").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("EX").Visible = xlVeryHidden
Range("C4").Select
Application.ScreenUpdating = True
End If
End Sub