Currently if I select multiple cells only the first cell gets subfolders. There are also cells that get selected that do not find the path and therefore cannot create the file. My code is below.

I am attempting to create a folder and hyperlink in excel with 6 subfolders that will always be the same.

Sub FileHyperlink1()
'
'remember to select the cells you want to turn into folders before running the macro

'Default location where to select folder
Dim CreateAt As String
CreateAt = "G:QUALITYCorrective Actions2024"
'Dim OpenAt As String
'OpenAt = "G:QUALITYCorrective Actions2024"

BrowseForFolder = "G:QUALITYCorrective Actions2024"

'get the range of cells that were selected before the macro was run
Dim Rng As Range
Dim maxRows, maxCols, r As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count

'---loop through all cells within selected range---
    r = 1
    Do While r <= maxRows

            'create hyperlink in Excel file to newly created folder
            Dim cnf
            Set cnf = CreateObject("Scripting.FileSystemObject")

                cnf.CreateFolder (BrowseForFolder & "" & Rng(r))
               ActiveSheet.Hyperlinks.Add Anchor:=Rng(r), Address:=BrowseForFolder & "" & Rng(r)
 'Create subfolder
 
                Dim cnsf
                Set cnsf = CreateObject("Scripting.FileSystemObject")
                
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "1_Email")
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "2_Traceability")
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "3_Pictures")
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "4_QA")
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "5_8D")
                cnsf.CreateFolder (BrowseForFolder & "" & Rng(r) & "6_Archive")
                        
                'End If

            On Error Resume Next
    
        'if the selected cell contains nothing, then do nothing and go to the next cell
        'End If
       
        r = r + 1
' Macro1 Macro
'
Loop
'
End Sub