Need help with 2nd Variable Like I have for my Archive macro.

S

ShawnSPS

Board Regular
Joined
Mar 15, 2023
Messages
61
Office Version
  1. 2003 or older
Platform
  1. Windows
I have expanded on my Archive Macro. In which the user does not have to create the subfolder “Archive Notes” in my documents, I added another Variable to allow it to Make the directory for the folder. I would like to do the same for “SaveNextMonth” Macro I am lost on how to include the new Variable. I have included both the working Macro for “Archive” and “SaveNextMonth” to see changes.



VBA Code: 
Sub archive()
Dim SavePath As String, ArchivePath As String
ActiveSheet.Copy
             SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
          [COLOR=rgb(65, 168, 95)]   ArchivePath = Environ("userprofile") & "\my documents\Archive Notes"
             If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
             MkDir ArchivePath[/COLOR]
End If
            Application.DisplayAlerts = False
            ActiveSheet.SaveAs SavePath
            ActiveWorkbook.Close
            Range("b2:d5000").Clear
End Sub



I need to add the 2nd Variable like I have above in “Archive Macro” to Make the directory folder “Office Counts” which the users do not need to create the folder the Marco will do that with the Variable. Please see “Archive Macro” I just don’t know where to begin on this one.



VBA Code: 
Sub SaveNextMonth()
Application.ScreenUpdating = False
Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String
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:=Environ("userprofile") & "\my documents\Office 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
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
Hi @ShawnSPS , thanks for posting on MrExcel.

I hope I understood your requirement, try this:

VBA Code: 
Sub SaveNextMonth()
  Application.ScreenUpdating = False
  
  Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String
  
  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
    SavePath = Environ("userprofile") & "\my documents\Office Counts\"
    If Len(Dir(SavePath, vbDirectory)) = 0 Then
      MkDir SavePath
    End If
    ActiveWorkbook.SaveCopyAs Filename:=SavePath & 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


--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​
 
Upvote 0
DanteAmor said:
Hi @ShawnSPS , thanks for posting on MrExcel.

I hope I understood your requirement, try this:

VBA Code: 
Sub SaveNextMonth()
  Application.ScreenUpdating = False
 
  Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String
 
  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
    SavePath = Environ("userprofile") & "\my documents\Office Counts\"
    If Len(Dir(SavePath, vbDirectory)) = 0 Then
      MkDir SavePath
    End If
    ActiveWorkbook.SaveCopyAs Filename:=SavePath & 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


--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​
Click to expand...
DanteAmor said:
Hi @ShawnSPS , thanks for posting on MrExcel.

I hope I understood your requirement, try this:

VBA Code: 
Sub SaveNextMonth()
  Application.ScreenUpdating = False
 
  Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String
 
  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
    SavePath = Environ("userprofile") & "\my documents\Office Counts\"
    If Len(Dir(SavePath, vbDirectory)) = 0 Then
      MkDir SavePath
    End If
    ActiveWorkbook.SaveCopyAs Filename:=SavePath & 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


--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​
Click to expand...
Hey thanks for the help, unfortunately that is not exactly want I need. you are still missing a piece of VBA code for the 2nd Variable. I tested your code and it did not create the folder or save the name given when it was entered. .. but it did clear out the data from the range given. . look below : this is the full piece of code that needs to be implemented with in the "SaveNextMonth"

VBA Code: 
           ActiveWorkbook.SaveCopyAs Filename:=Environ("userprofile") & "\my documents\Office Counts\" & fName & ".xls"
           ArchivePath = Environ("userprofile") & "\my documents\Office Counts"
            If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
             MkDir ArchivePath
 
Upvote 0
VBA Code: 
Sub SaveNextMonth()
    Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String, ArchivePath As String
    ActiveSheet.Copy
    SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
    ArchivePath = Environ("userprofile") & "\my documents\Archive Notes"
    If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
        MkDir ArchivePath
    End If
    Application.DisplayAlerts = False
    ActiveSheet.SaveAs SavePath
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
    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 GoTo BailOut
        ArchivePath = Environ("userprofile") & "\my documents\Monthly Counts"
        If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
            MkDir ArchivePath
        End If
        ActiveWorkbook.SaveCopyAs Filename:=Environ("userprofile") & "\my documents\Monthly 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
BailOut:
End Sub

I was wrapping my head around this for a few days and came up with this code that works - it a little muddy but again I still a novice when it code to writing vba code I try my best to keep it clear and simple but at times it just can't without guidance. so if anyone has a better way of writing what I going then great it not then this is my solution to my iss
 
Upvote 0
ShawnSPS said:
VBA Code: 
Sub SaveNextMonth()
    Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String, ArchivePath As String
    ActiveSheet.Copy
    SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
    ArchivePath = Environ("userprofile") & "\my documents\Archive Notes"
    If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
        MkDir ArchivePath
    End If
    Application.DisplayAlerts = False
    ActiveSheet.SaveAs SavePath
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
    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 GoTo BailOut
        ArchivePath = Environ("userprofile") & "\my documents\Monthly Counts"
        If Len(Dir(ArchivePath, vbDirectory)) = 0 Then
            MkDir ArchivePath
        End If
        ActiveWorkbook.SaveCopyAs Filename:=Environ("userprofile") & "\my documents\Monthly 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
BailOut:
End Sub

I was wrapping my head around this for a few days and came up with this code that works - it a little muddy but again I still a novice when it code to writing vba code I try my best to keep it clear and simple but at times it just can't without guidance. so if anyone has a better way of writing what I going then great it not then this is my solution to my iss
Click to expand...
Well since nobody has stepped up - with any alternative I am going to marked as solved.
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

S
  • Solved
System Variables so I do not need to Hard code a path to save file to a fold in the documents area.
2
Replies
19
Views
1K
Fluff
Fluff
S
  • Solved
Need help with vba code, I need to have file saved before the data is cleared currently it deletes the data before saving.
Replies
3
Views
570
Anthony47
A
S
  • Question Question
Need to save a years worth of notes
Replies
1
Views
342
ShawnSPS
S
J
  • Question Question
Macro to pull Office 365 'Comments' onto new tab like I previously did with what's now 'Notes'
Replies
1
Views
119
jkouvel
J
S
  • Solved
three Marco’s that I would like to combine into one action when a button is pressed
2 3
Replies
23
Views
1K
smozgur
smozgur

Forum statistics

Threads
1,223,898
Messages
6,175,272
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top