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

Participate now!

Share

Tags