Help!! Output list of folders to particular cell

[bsfreeman]

Hi, Need some help with my VBA as I'm new to all this.

I have so far made some code which will look at a folder, that is selected in cell B1, and then create a list of all the folder names inside that folder and then turn all of the names into hyperlinks to the folder in question. The problem comes when I change folders which will happen every month.

Is it possible to output this list of folders to a pre-defined cell that could be set in excel, say cell D1, so that when the folder is changed every month they will not overwrite the previous months folder names. I have tried this twice but failed each time.

Thanks for any help in advance.

Below is the code I have written so far.

Sub Example1()

Dim wb As Workbook
Dim WS As Worksheet
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = ""

    Set wb = ThisWorkbook
    Set wsControl = wb.Sheets("Control")
    Folder_Name = wsControl.Cells(1, 2)
    If Folder_Name = "" Then
        MsgBox "Path location is not entered. Please enter path"
        wsControl.Cells(1, 2).Select
        End
    End If
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(Folder_Name)
i = 1
'loops through each file in the directory
For Each objSubFolder In objFolder.subfolders
    'select cell
    Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objSubFolder.Path, _
        TextToDisplay:=objSubFolder.Name
    i = i + 1
Next objSubFolder

    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Control").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Control").sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Control").sort
        .SetRange Range("A2:A1000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

[GeneralDisarray]

Please edit your post, refer to rule#3 of the forum rules:


3. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the [#] button at the top of the post window (if you are editing an existing post, press Go Advanced to see the [#] button). The result will appear like this in the post window:

[code ]
your code here ...
and here ...
and here
[ /code]

... and appear like this when posted:

 your code here ...
 and here ...
 and here

You can also type the code tags in manually if you prefer. For more information about these and other tags, click here.

[6StringJazzer]

Moderator's note: Please take the time to review our rules. There aren't many, and they are all important. Rule #3 requires code tags. I have added them for you this time because you are a new member.

[bsfreeman]

Thanks, will read them.

[GeneralDisarray]

Ok, thank you for editing that. Would it work if you just had the folder names with links added to a growing list?

You could do that by changing one line of code there:

This line:

Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select

Becomes:

WS.Cells(rows.count, 1).End(xlUp).Offset(1,0).Select

That should do it - it will find the next blank row to place the link. I used the WS.CELLS() instead of the RANGE() you were using - that is just how I would do that. The key step is finding the bottom row and offsetting by 1 row.

[bsfreeman]

Yes that seems the more efficent way of doing it. Although I tried the code and it didn't work. You mean as it is below?

Sub Example1()

Dim wb As Workbook
Dim WS As Worksheet
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = ""

    Set wb = ThisWorkbook
    Set wsControl = wb.Sheets("Control")
    Folder_Name = wsControl.Cells(1, 2)
    If Folder_Name = "" Then
        MsgBox "Path location is not entered. Please enter path"
        wsControl.Cells(1, 2).Select
        End
    End If
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(Folder_Name)
i = 1
'loops through each file in the directory
For Each objSubFolder In objFolder.subfolders
    'select cell
    WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objSubFolder.Path, _
        TextToDisplay:=objSubFolder.Name
    i = i + 1
Next objSubFolder

    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Control").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Control").sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Control").sort
        .SetRange Range("A2:A1000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub