Reference a filepath from a cell

[k10riley]

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.

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

 

[Rick Rothstein]

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

 

[k10riley]

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

When I do that though, I get the following error:

with this section highlighted:

 

[EdNerd]

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.

 

[k10riley]

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.

Interesting.

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

and also opens this person's workbook.

 

[k10riley]

Interesting.

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

and also opens this person's workbook.

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!)

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

 

[EdNerd]

Glad I could could be of some help to you. :8>)