list files as hyperlink located in multiple subfolder using vba

I trying to do a hyperlink of .xlsm files that are found in multiple subfolders and list them in column B starting at row 12. This is what I started with and can't get it to work once I change the "A" to "B". It list the second file correctly however the 1st is using the path for the second one. The second part is taking and removing the .xlsm from cell while keeping the path and then putting Last name in column B and first name in column C. Can anyone tell me where I am going wrong or how to improve. Ultimately what I am trying to do is look in folder "Attendance" List each subfolder with the xlsm file in it and hyperlink that file to the name of the folder. End game is to open each .xlsm filepath and get data from different cells into current sheet as well as match name in the .xslm file. Hope this makes sense. orginal excel Making this file VBA instead of formula based. Still learning VBA

Sub VBA_Loop_Through_all_Files_in_subfolders_Using_FSO_Early_Binding()

'Variable Declaration
Dim oFSO As FileSystemObject, oFolder As Object
Dim oSubFolders As Object, oSFolderFile As Object
Dim sFile As Object, sfolders As Object
Dim Wbook As Workbook
Dim i  As Integer
Dim cell As Range

'Initialize value
i = 12  'orginal i = 1

'Set objects
Set oFSO = New FileSystemObject
Set oFolder = oFSO.GetFolder("C:\Users\jvittur\OneDrive\Desktop\Attendance")
Set oSubFolders = oFolder.SubFolders

'Loop through subfolders
For Each sfolders In oSubFolders
     Sheet1.Range("B" & i) = sfolders.Name 'orginal Sheet1.Range("A" & i) = sfolders.Name
    Set oSFolderFile = sfolders.Files
    
    'Loop through all files in a subfolder
    For Each sFile In oSFolderFile
        Sheet1.Range("B" & i) = sFile.Name 'orginal Sheet1.Range("A" & i) = sFile.Name
              
              With ActiveSheet
    For Each cell In .Range("B12", .Cells(.Rows.Count, "B").End(xlUp)) 'orgnial For Each cell In .Range("A12", .Cells(.Rows.Count, "A").End(xlUp))
        .Hyperlinks.Add Anchor:=cell, Address:=sFile
    Next
End With

Next
    i = i + 1
     

    Next

 Call RemoveExtension(Range("B12:B500")) 'Orginal ("A12:A500"))
'Release the memory
Set oFSO = Nothing
Set oFolder = Nothing
Set oSubFolders = Nothing
Set oSFolderFile = Nothing

End Sub


Sub RemoveExtension(rng As Range)
' Declare your variables
Dim LR As Long
Dim i As Long
Dim str() As String

With rng
  ' Find the last row
  LR = .Cells(.Rows.Count, 1).End(xlUp).Row
  ' Enter loop
  For i = LR To 1 Step -1
     If Not (IsEmpty(.Cells(i))) Then
        ' Extract and split text using "." as a delimiter
        str() = Split(.Cells(i).Value, ".")
        ' Rewrite text in cell from first array variable in str()
        .Cells(i).Value = str(0)
     End If
  Next i
End With
End Sub

This works for me:

Sub VBA_Loop_Through_all_Files_in_subfolders_Using_FSO_Early_Binding()
    'use const for fixed values
    Const FLDR As String = "C:\Users\jvittur\OneDrive\Desktop\Attendance"
    Const LIST_START_ADDR As String = "B12"
    
    Dim oFSO As FileSystemObject, oFolder As Object, c As Range
    Dim oSFolderFile As Object, sFile As Object, sfolder As Object
    
    Set oFSO = New FileSystemObject
    Set oFolder = oFSO.GetFolder(FLDR)
    
    Set c = Sheet1.Range(LIST_START_ADDR) 'start here
    
    For Each sfolder In oFolder.SubFolders     'loop through subfolders
        For Each sFile In sfolder.Files        'loop all files in each subfolder
            If sFile.Name Like "*.xlsm" Then   'do we want to list this file?
                c.Worksheet.Hyperlinks.Add Anchor:=c, Address:=sFile.Path, _
                               TextToDisplay:=oFSO.GetBaseName(sFile.Name)
                Set c = c.Offset(1)            'next cell down
            End If 'is .xlsm file
        Next sFile
    Next sfolder
End Sub

Note you do not need to write a method to get the file name without the extension. FileSystemObject already has GetBaseName which does that.