VBA Macro, file path to reference a cell in the workbook

cmars_h · Mar 9th 2021

Hello

I need a little help with some VBA code I have inherited. I want to change it so that the user enters in the folder location in a cell on the first page of the workbook (Cell B3, work sheet name: Extract) as opposed to editing the macro each time they want to change folder location.

Please find the code below, any help would be very much appreciated as I am very new to this!

Code

Sub Extract_all_locations()
Dim LastRow As Long
Dim NextRow As Long
Dim col As Long
Dim strFile As String
Dim arrShts As Variant
Dim vSht As Variant
arrShts = Array("DS9", "Voyager", "Enterprise")
For Each vSht In arrShts
If Not IsSheet(ThisWorkbook.Sheets, CStr(vSht)) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = vSht
End If
Next
Const strPath As String = "C:\Users\bsisko\Desktop\locations\"
strFile = Dir(strPath & "*.xls*")
col = 2
Application.ScreenUpdating = False
Do While strFile <> ""
With Workbooks.Open(strPath & strFile)
For Each vSht In arrShts
If IsSheet(.Sheets, CStr(vSht)) Then
ThisWorkbook.Sheets(vSht).Cells(1, col).Value = .Name
LastRow = .Sheets(vSht).Cells.Find("*", , , , 1, 2).Row
NextRow = ThisWorkbook.Sheets(vSht).Cells(Rows.Count, col).End(xlUp).Row + 1
ThisWorkbook.Sheets(vSht).Cells(NextRow, col).Resize(LastRow, 9).Value = .Sheets(vSht).Range("c1:k" & LastRow).Value
End If
Next vSht
.Close SaveChanges:=False
End With
col = col + 4
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Function IsSheet(shts As Sheets, strSheet As String) As Boolean
On Error Resume Next
IsSheet = LCase(shts(strSheet).Name) = LCase(strSheet)
End Function

Display More

**Carim** · Mar 9th 2021

Hello and Welcome to the Forum

Let us say, for example, in your worksheet named Extract, the Cell B3 holds C:\Users\bsisko\Desktop\locations\

Then, you should replace Line #18 in your macro which is currently:

Const strPath As String = "C:\Users\bsisko\Desktop\locations\"

by the following new instruction:

strPath = Sheets("Extract").Range("B3").Value

Hope the explanation is clear enough

**royUK** · Mar 9th 2021

You also need to declare the variable, a Constant cannot be changed within the code.

Code

Dim strPath As String

If you use Option Explicit at the top of the code then such errors will be flagged by the VB Editor's Intellisense. Read this to understand

Option Explicit

gruhyrose · Mar 9th 2021

thanks for share, that's awesome.

cmars_h · Mar 10th 2021

Hi All

Thank you for your help with this, I've made the changes as suggested above (in rows 9 [royUK], and 20 [Carim] of the code). I have added my file location to cell B3 (C:\Users\bsisko\Desktop\locations\ ) in a worksheet called "Extract".

However I get the debug error and row 31 is high lighted in yellow when I access the code, also it opens the first workbook located in the "locations" folder to the first sheet which in this case is "DS9".

Any ideas???

Claire

Code

Sub Extract_all_locations()
Dim LastRow As Long
Dim NextRow As Long
Dim col As Long
Dim strFile As String
Dim arrShts As Variant
Dim vSht As Variant
Dim strPath As String
arrShts = Array("DS9", "Voyager", "Enterprise")
For Each vSht In arrShts
If Not IsSheet(ThisWorkbook.Sheets, CStr(vSht)) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = vSht
End If
Next
strPath = Sheets("Extract").Range("B3").Value
strFile = Dir(strPath & "*.xls*")
Application.ScreenUpdating = False
Do While strFile <> ""
With Workbooks.Open(strPath & strFile)
For Each vSht In arrShts
If IsSheet(.Sheets, CStr(vSht)) Then
ThisWorkbook.Sheets(vSht).Cells(1, col).Value = .Name
LastRow = .Sheets(vSht).Cells.Find("*", , , , 1, 2).Row
NextRow = ThisWorkbook.Sheets(vSht).Cells(Rows.Count, col).End(xlUp).Row + 1
ThisWorkbook.Sheets(vSht).Cells(NextRow, col).Resize(LastRow, 4).Value = .Sheets(vSht).Range("c1:f" & LastRow).Value
End If
Next vSht
.Close SaveChanges:=False
End With
col = col + 4
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Function IsSheet(shts As Sheets, strSheet As String) As Boolean
On Error Resume Next
IsSheet = LCase(shts(strSheet).Name) = LCase(strSheet)
End Function

Display More

**royUK** · Mar 10th 2021

Where do you assign a value to col?

cmars_h · Mar 10th 2021

Hi

As I've inherited the code the only parts I edit is the folder location (row 12 of code above) and sometimes the number of columns and range of cells (row 37) if I'm working with different workbook types. It's been working perfectly and I don't set the col value, so I'm not sure if that helps or not!

Claire

VBA Macro, file path to reference a cell in the workbook

Share

Similar Threads

Getting sheet names from a second excel file using a macro. (Run-time error '9': Subscript out of range)

Tags