crystalneedshelpplzthnx

Board Regular
Joined
Nov 24, 2017
Messages
55
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I would like assistance creating a message box to find and replace the location of the files being saved. There are several files, but all are saved to

C:\Users\xxx\OneDrive - xxx\xxx\Daily Reports

on my system.

I am attempting to create an easy update to the macro if another user needs to run this macro. I'm requesting code to customize to their own location with a simple find replace at the beginning of the macro.

My idea: Once the macro is ran the user gets a pop up asking if the save location needs to be updated (Yes / No)

If yes another box to input file save location (which will then replace my location with theirs in the code...and the macro finishes as usual.

If no, macro continues as is...

Is there a way to do this within the current macro?

Thnx for your help in advance.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Hi,
always helpful if you share macro you want to modify but as a bit of a guess, see if following goes in right direction.


Place following code in a STANDARD module

Rich (BB code):
Function ChangeFolderPath(ByVal FolderPath As Variant) As Variant
    Dim Folder As FileDialog
    Dim Item As Variant
    Dim Result As VbMsgBoxResult
    
    Result = MsgBox(FolderPath & Chr(10) & "Do You Want To Change Save Location Folder Path?", 36, "Change Folder Path")
    If Result = vbNo Then Item = CVErr(10): GoTo ExitFunction
    
    On Error Resume Next
    If Dir(FolderPath, vbDirectory) = vbNullString Then FolderPath = ThisWorkbook.Path
    Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
    
    
    With Folder
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .ButtonName = "Select Folder"
        .InitialFileName = FolderPath
'cancel pressed
        If .Show <> -1 Then
            Item = CVErr(10)
        Else
'folder selected
            Item = .SelectedItems(1)
        End If
    End With
    
ExitFunction:
    ChangeFolderPath = Item
    Set Folder = Nothing
    On Error GoTo 0
End Function


In your existing code add following lines of code at beginning:

Rich (BB code):
Dim FolderPath As Range
Dim Folder As Variant


'place holder for folder path (change as required)
    Set FolderPath = ThisWorkbook.Worksheets("Sheet1").Range("A10")
'return updated folder path
    Folder = ChangeFolderPath(FolderPath.Value)
'update folder path to range
    If Not IsError(Folder) Then FolderPath.Value = Folder
    
    'rest of your code

If you don't have one already, you will need a place holder in your workbook for the Save Location Folder. Change values I have shown in RED as required

What should happen when code is run is a MsgBox appears and asks you if you want to update folder location. Pressing Yes displays a Folder Dialog which will allow users to navigate to the correct folder location. When selected, this will update The Range in your worksheet.


Hope Helpful

Dave
 
Upvote 0
I think I follow, but I want to double check updating the place holder with you.

Rich (BB code):
'Command for folder date format
Dim fsoObj As Object, TheDate As String
TheDate = Format(Date, "MMDDYY")

'Find todays folder or create todays folder if not found
Dim strDir As String
    strDir = "C:\Users\xxx\xxx\xxx\Daily Reports" & TheDate
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
Else
End If

'Save WORKING WORKBOOK
ChDir _
        "C:\Users\xxx\xxx\xxx\Daily Reports\" & TheDate
    ActiveWorkbook.SaveAs Filename:= _
    "Morning Reports " & Format(Now, "m.d.yy") & " WORKING.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False


Should now be

After adding Function to module...

Rich (BB code):
Dim FolderPath As Range
Dim Folder As Variant

'place holder for folder path (change as required)
    Set FolderPath = "C:\Users\xxx\xxx\xxx"
'return updated folder path
    Folder = ChangeFolderPath(FolderPath.Value)
'update folder path to range
    If Not IsError(Folder) Then FolderPath.Value = Folder

'Find todays folder or create todays folder if not found
Dim strDir As String
    strDir = FolderPath & "\Daily Reports\" & TheDate
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
Else
End If

'Save WORKING WORKBOOK
ChDir _
        FolderPath & "\Daily Reports\" & TheDate
    ActiveWorkbook.SaveAs Filename:= _
    "Morning Reports " & Format(Now, "m.d.yy") & " WORKING.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False

I need to get in the habit of using place holders...I'll try this. Hope I understood, your instructions were very clear. Thnx Dave!
 
Last edited:
Upvote 0
I'm doing something wrong. I realized I can not create the "Daily Reports" part of the path...I can only create one with MkDir, so I'll settle with the date only.

Is there a way to put the file path in the place holder, instead of referencing a cell?

Should I post more of my original code?

Thnx again.
 
Upvote 0
Hi,
in my example, the place holder for the folder path is a Range (cell in a worksheet) which is a commonly used approach as it removes need for hard coding. The range can be in an existing worksheet or you can add another (and hide it) if you want to keep it separate from your working data.

Suggest add a worksheet & update this line of my code

Rich (BB code):
'place holder for folder path (change as required)
    Set FolderPath = ThisWorkbook.Worksheets("Sheet1").Range("A10")

with the sheet name & cell you want to hold Folder Path.

If suggestion is going in right direction should not need to see all your code.


Dave
 
Upvote 0

Forum statistics

Threads
1,215,855
Messages
6,127,349
Members
449,381
Latest member
Aircuart

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