VBA to select folder location

[BPMDBal18]

Hello All,

I have an excel function that I'm using to aggregate a bunch of files into a single excel sheet. Right now it's hard coded to pull from a specific folder location, but I would like a user to be able to select the area where the excel files are located. Can anyone assist?

Sub ImportGroups()
Dim fPATH As Variant, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet
Application.ScreenUpdating = False


Set wsDEST = ThisWorkbook.Sheets("Summary")
NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1


fPATH = "Folder path"     'folder path would normally be inserted here


fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath


Do While Len(fNAME) > 0
    Set wbGRP = Workbooks.Open(fPATH & fNAME)   'open the file
    LR = Range("B" & Rows.Count).End(xlUp).Row  'how many rows of info?
    
    If LR > 1 Then
        Range("A8:BF" & LR).Copy wsDEST.Range("A" & NR)
        NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1
    End If
    
    wbGRP.Close False   'close data workbook
        fNAME = Dir         'get the next filename
Loop


End Function

 

[Veritan]

Hello, a similar question was asked over at StackOverflow. The answer there seems like something that you could adapt for your specific scenario. Out of curiosity, why does your code start as a Sub but end as a Function? I would think you would want to pick a single value for both the opening and closing lines of code.

 

[Norie]

Try this.

Sub ImportGroups()
Dim fPATH As Variant, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet

    Application.ScreenUpdating = False

    Set wsDEST = ThisWorkbook.Sheets("Summary")
    NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1

    fPATH = GetFolder("C:\")    ' change C:\ to the folder you want to start the dialog in

    fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath

    Do While Len(fNAME) > 0
        Set wbGRP = Workbooks.Open(fPATH & fNAME)   'open the file
        LR = Range("B" & Rows.Count).End(xlUp).Row  'how many rows of info?

        If LR > 1 Then
            Range("A8:BF" & LR).Copy wsDEST.Range("A" & NR)
            NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1
        End If

        wbGRP.Close False   'close data workbook
        fNAME = Dir         'get the next filename
    Loop

End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

 

[BPMDBal18]

Hello, a similar question was asked over at StackOverflow. The answer there seems like something that you could adapt for your specific scenario. Out of curiosity, why does your code start as a Sub but end as a Function? I would think you would want to pick a single value for both the opening and closing lines of code.

Sorry, I'm very new to VBA. I did notice the Function issue after I sent it and corrected it. How would I integrate the code from Stack overflow into the current code that I have. I tried and the function was having issues running. Any pointers would be greatly appreciated.