Reference a filepath from a cell

K

k10riley

New Member
Joined
Dec 1, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hi! Okay, I have built out some code that will generate surveys based on information from a workbook. In my code, instead of having to update the filepath I would like to be able to just reference a cell and have the code pull from there. That way I can change the filepath in the cell rather than code.

VBA Code: 
Sub GenerateSurveys()

Application.ScreenUpdating = False

Dim rng As Range
Dim dataValidationArray As Variant
Dim i As Integer
Dim rows As Integer
Dim filepath As String
Dim filename As String

'activate correct sheet
'** edit Consolidated Responses parameter as necessary to reflect sheet name
Sheets("2021 Initial Distribution").Activate

'identify the cell containing the respondent name
'**edit Consolidated Responses and C9 parameter as necessary
Set rng = Sheets("2021 Initial Distribution").Range("C9")

'create an array from the Data Validation formula, without creating a multi-dimensional array from the range
rows = Range(Replace(rng.Validation.Formula1, "=", "")).rows.count
ReDim dataValidationArray(1 To rows)

For i = 1 To rows
    dataValidationArray(i) = _
        Range(Replace(rng.Validation.Formula1, "=", "")).Cells(i, 1)
Next i

'loop through all respondent names
For i = LBound(dataValidationArray) To UBound(dataValidationArray)

    'change the value in the data validation cell
    rng.Value = dataValidationArray(i)
    
    'Force the sheet to recalculate
    Application.Calculate
    
    'selects cell to filter on
    '** edit H11 parameter as necessary
    Range("H11").Select
    Selection.AutoFilter
    
    'filter criteria set to "Y"
    '**edit $B$11:$H1000 and 7 parameters as necessary (field # should correspond to the column number within the table)
    ActiveSheet.Range("$B$11:$H$1000").AutoFilter Field:=7, Criteria1:="Y"
    
    'select the relevant data (table for all populated cells)
    '**edit A1:L1 parameter to capture all columns (including hidden)
    Range("A1:L1", Selection.End(xlDown)).Select
    Selection.Copy
    
    'create a new workbook
    Workbooks.Add
    
    'change sheet name
    ActiveSheet.Name = dataValidationArray(i)
    
    'paste information while maintaining formatting
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    ActiveWindow.DisplayGridlines = False
    Range("A1").RowHeight = 5
    Range("A4").RowHeight = 5
    
    'add freeze panes
    '** edit B12 parameter as necessary
    Range("B12").Select
    ActiveWindow.FreezePanes = True
    
    'hide columns
    Range("G:L").EntireColumn.Hidden = True
    
    'remove data validation
    '** edit C9 parameter as necessary
    Range("C9").Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    'name and save file
    '** edit file path as necessary
    filepath = "C:\2021 Initial Surveys"
    filename = "2021 Model Survey - " & dataValidationArray(i)
    ActiveWorkbook.SaveAs filename:=filepath & "\" & filename _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
    'return to original workbook and unfilter data
    '** update file name and sheet name as necessary
    Windows("2021 Model Survey Administration.xlsm").Activate
    Sheets("2021 Initial Distribution").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    
'moves to next name
Next i

'reset mouse to cover sheet
Sheets("Cover").Select

End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
The filepath is just a text string so you can put the text in the cell of your choice and then assign that cell's value to the filepath variable. So, assuming you put the path text (C:\2021 Initial Surveys) (note, no quote marks) in cell X1, then instead of this...

filepath = "C:\2021 Initial Surveys"

do this...

filepath = Range("X1").Value
 
Upvote 0
Solution
Rick Rothstein said:
The filepath is just a text string so you can put the text in the cell of your choice and then assign that cell's value to the filepath variable. So, assuming you put the path text (C:\2021 Initial Surveys) (note, no quote marks) in cell X1, then instead of this...

filepath = "C:\2021 Initial Surveys"

do this...

filepath = Range("X1").Value
Click to expand...
When I do that though, I get the following error:

1638900856256.png


with this section highlighted:
1638900888532.png
 
Upvote 0
You can try opening the Immediate Window (CTRL+G), and between filename = and ActiveWorkbook.SaveAs put
Debug.Print filepath & "\" & filename
and see what comes up.
 
Upvote 0
EdNerd said:
You can try opening the Immediate Window (CTRL+G), and between filename = and ActiveWorkbook.SaveAs put
Debug.Print filepath & "\" & filename
and see what comes up.
Click to expand...
Interesting.

So when I do that, it returns the following:
John Doe\2021 Model Survey - John Doe

and also opens this person's workbook.
 
Upvote 0
k10riley said:
Interesting.

So when I do that, it returns the following:
John Doe\2021 Model Survey - John Doe

and also opens this person's workbook.
Click to expand...
AH, thank you EdNerd!

I realized that there was an extra *\* in the code and that was messing up the format to save the file!

So final code with help from EdNerd and Rick (THANK YOU!)

VBA Code: 
Sub GenerateSurveys()

Application.ScreenUpdating = False

Dim rng As Range
Dim dataValidationArray As Variant
Dim i As Integer
Dim rows As Integer
Dim filepath As String
Dim filename As String

'activate correct sheet
'** edit Consolidated Responses parameter as necessary to reflect sheet name
Sheets("2021 Initial Distribution").Activate

'identify the cell containing the respondent name
'**edit Consolidated Responses and C9 parameter as necessary
Set rng = Sheets("2021 Initial Distribution").Range("C9")

'create an array from the Data Validation formula, without creating a multi-dimensional array from the range
rows = Range(Replace(rng.Validation.Formula1, "=", "")).rows.count
ReDim dataValidationArray(1 To rows)

For i = 1 To rows
    dataValidationArray(i) = _
        Range(Replace(rng.Validation.Formula1, "=", "")).Cells(i, 1)
Next i

'loop through all respondent names
For i = LBound(dataValidationArray) To UBound(dataValidationArray)

    'change the value in the data validation cell
    rng.Value = dataValidationArray(i)
    
    'Force the sheet to recalculate
    Application.Calculate
    
    'selects cell to filter on
    '** edit H11 parameter as necessary
    Range("H11").Select
    Selection.AutoFilter
    
    'filter criteria set to "Y"
    '**edit $B$11:$H1000 and 7 parameters as necessary (field # should correspond to the column number within the table)
    ActiveSheet.Range("$B$11:$H$1000").AutoFilter Field:=7, Criteria1:="Y"
    
    'select the relevant data (table for all populated cells)
    '**edit A1:L1 parameter to capture all columns (including hidden)
    Range("A1:L1", Selection.End(xlDown)).Select
    Selection.Copy
    
    'create a new workbook
    Workbooks.Add
    
    'change sheet name
    ActiveSheet.Name = dataValidationArray(i)
    
    'paste information while maintaining formatting
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    ActiveWindow.DisplayGridlines = False
    Range("A1").RowHeight = 5
    Range("A4").RowHeight = 5
    
    'add freeze panes
    '** edit B12 parameter as necessary
    Range("B12").Select
    ActiveWindow.FreezePanes = True
    
    'hide columns
    Range("G:L").EntireColumn.Hidden = True
    
    'remove data validation
    '** edit C9 parameter as necessary
    Range("C9").Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    'name and save file
    '** edit file path as necessary
    filepath = Range("C9").Value
    filename = "2021 Model Survey - " & dataValidationArray(i)
    ActiveWorkbook.SaveAs filename:=filepath & filename _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
    'return to original workbook and unfilter data
    '** update file name and sheet name as necessary
    Windows("2021 Model Survey Administration.xlsm").Activate
    Sheets("2021 Initial Distribution").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    
'moves to next name
Next i

'reset mouse to cover sheet
Sheets("Cover").Select

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Loop validation, copy output from same range and paste in different ranges
Replies
1
Views
394
RoryA
RoryA
M
  • Question
Loop Through Validation List and Copy Values Given for Each Item
Replies
1
Views
1K
mjgcancio
M
T
  • Question
Loop through folder and copy data into master spreadsheet
Replies
2
Views
279
TaskMaster
T
D
  • Question
Data from one sheet to overide data on another sheet
Replies
0
Views
184
Daroh
D
rjplante
  • Solved
Change from Set as Default to Set as Active printer
Replies
1
Views
221
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

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