System Variables so I do not need to Hard code a path to save file to a fold in the documents area.

[ShawnSPS]

Hello,



I am leaving you the above two codes. What I am trying to setup is a system variable for two of my Macros – one is called “Archive”& the other is called “SaveNextMonth”



The Idea is not have to hard code a path in the macro for each computer that the workbook is on. For those two Macros.



With the “Archive” Macro: I need it to save the zNotes worksheet into the folder called Archive Notes in the documents on the computer. and the clear the data with the range that I have give it. this is what I have write currently for “archive” how ever its not clearing out the data.



Sub archive()
Dim SavePath As String
ActiveSheet.Copy
SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
Application.DisplayAlerts = False
ActiveSheet.SaveAs SavePath
Range("b2:d5000").Clear
ActiveWorkbook.Close
End Sub




SaveNextMonth I haven’t got to it yet because of the issue with the “archive” Macro

But here is the current Macro: its basic the same concept that I need where the system variable is copying the workbook to a folder called Office Counts and then clearing out the data with the range I give it .. this Macro is current work but I don’t want to hard code a path – I want the system do to the work other I have go each computer and enter its path Manually which why the system Variable make more sense because it not OS dependant



Any direction would be helpful than you


Sub SaveNextMonth()
Application.ScreenUpdating = False
Dim mon As String, nextMon As String, fName As String, ws As Worksheet
mon = MonthName(Month(Date))
nextMon = MonthName(Month(Date) + 1)
If MsgBox("The current month will change to " & nextMon & " and all data from the previous month will be deleted. Are you sure you want to change the month and clear all data?", vbYesNo) = vbYes Then
fName = InputBox("Enter the file name to be used.")
If fName = "" Then Exit Sub
ActiveWorkbook.SaveCopyAs Filename:="C:\Users\Shawn\Desktop\2023 Counts\" & fName & ".xls"
For Each ws In Sheets
If ws.Name <> "Ablank" And "ws.Name" <> "Zdata" And "ws.Name" <> "ZShortCuts" Then
With ws
.Unprotect ("Pila1DA.#")
.Range("A1") = nextMon
.Range("D3:AH31,D34:AH41").ClearContents
.Protect ("Pila1DA.#")
End With
End If
Next ws
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

 

[rlv01]

For the archive macro (not tested)

Sub archive()
    Dim SavePath As String
    Dim WB As Workbook
    Dim ClearRange As Range

    SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
    With ActiveSheet
        Set ClearRange = .Range("b2:d5000")
        .Copy
    End With
    Set WB = ActiveWorkbook
    
    Application.DisplayAlerts = False
    WB.SaveAs Filename:=SavePath, FileFormat:=xlExcel8
    WB.Close False
    Application.DisplayAlerts = True
    
    With ClearRange
        .Parent.Activate
        .Select
        Select Case MsgBox("Clear this range?", vbYesNo Or vbQuestion Or vbDefaultButton2, .Address(0, 0, , 1))
        Case vbYes
            .Clear
        End Select
    End With
End Sub

 

[ShawnSPS]

For the archive macro (not tested)

Sub archive()
    Dim SavePath As String
    Dim WB As Workbook
    Dim ClearRange As Range

    SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
    With ActiveSheet
        Set ClearRange = .Range("b2:d5000")
        .Copy
    End With
    Set WB = ActiveWorkbook
   
    Application.DisplayAlerts = False
    WB.SaveAs Filename:=SavePath, FileFormat:=xlExcel8
    WB.Close False
    Application.DisplayAlerts = True
   
    With ClearRange
        .Parent.Activate
        .Select
        Select Case MsgBox("Clear this range?", vbYesNo Or vbQuestion Or vbDefaultButton2, .Address(0, 0, , 1))
        Case vbYes
            .Clear
        End Select
    End With
End Sub

I have tested your cold this is the following error I get

WB.SaveAs Filename:=SavePath, FileFormat:=xlExcel8

Run time error ‘1004’

Method ‘SaveAs’ of object ‘_workbook failed

 

[Fluff]

With your code, try swapping these two lines round

Range("b2:d5000").Clear
ActiveWorkbook.Close

 

[ShawnSPS]

With your code, try swapping these two lines round

Range("b2:d5000").Clear
ActiveWorkbook.Close

Thank you that did the trick. now it just getting "SaveNextMonth" Macro on the same page. as the 'Archive" Macro use the system variables

 

[ShawnSPS]

I have included the working workbook so anyone can understand how I have this setup

CheatBlankcount4.xls

Shared with Dropbox

www.dropbox.com

 

[Fluff]

Have you tried changing the file path to match what you have in the "arichive" code?

 

[ShawnSPS]

anomaly

Have you tried changing the file path to match what you have in the "arichive" code?

Yes, It work but I get a strange anomaly, when I enter the new file name to be saved. and it does save to the folder given. it saves it with the wrong year .. it show 2021 instead of 2023 I look at the code and and it seems right. it kinda strange .. I gave you the workbook maybe you can recreate the issue ..

 

[Fluff]

There is nothing in the code to save the year.

 

[ShawnSPS]

There is nothing in the code to save the year

Hmm Ok. I thought there was, so that was my mistake.