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

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
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 Question
Loop validation, copy output from same range and paste in different ranges
Replies
1
Views
715
RoryA
RoryA
R
  • Solved
Export excel file as PDF into a targeted pc folder based on cell value
Replies
2
Views
197
Ramadan2512
R
R
  • Solved
Make directory
Replies
6
Views
94
Joe4
Joe4
D
  • Question Question
Can't get folder to create on desktop. When debugging it shows no errors.
2 3
Replies
24
Views
391
jolivanes
jolivanes
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
205
Tanquen
T

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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