Parse Data file to copy values into a Column format

Hi-
I have a hurdle I am trying to overcome I think VB will help me achieve my goal, I don't have any experience with VB, but I do have experience with formulas and data manipulation using Excel. However, the format of the data file has left me in a quandary. I am trying to parse the data in an output/data file and place it into a column format so I can do look-ups and summaries. The file is a grouping of time records. I need to associate each record with an individual. This is my problem, the individual's name is a header for the group of times. The group of times are in a list below the header. The number of time records within in a group will vary so I can't always go to the same cell to grab an individuals name. The number of individuals will also vary from each file.

The data I am hoping to work with would look like this;

Column 1 Column 2 Column3 Column 4
Name time date Charge To Time value
Name time date Charge To Time value

I have attached 2 data files, I have also attached a final output file, which has two sheets. The first sheet is what the parsing should do to the 2 data files. The second sheet of the output file is what I will be doing to summarize the data from the first sheet. Let me know if I still haven't done a good job in explaining what I am trying to accomplish.

Example - data file1.xls
Example - data file2.xls
final output.xlsx

Researcher007,

This code will prompt you to select files that you want to create the parsing output from. It will then use the contents of those files to create the parsing output as specified by your 'final parsing output from data' sheet in your final output.xlsx example file.

Sub tgr()
    
    Dim rngFound As Range
    Dim rngDate As Range
    Dim rngCharge As Range
    Dim arrData(1 To 1000000, 1 To 5) As Variant
    Dim DataIndex As Long
    Dim FileIndex As Long
    Dim strPeriod As String
    Dim strYear As String
    Dim strFirst As String
    Dim strName As String
    Dim strChecked As String
    Dim strChargeTo As String
    Dim dtStart As Date
    Dim dtDate As Date
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub  'Pressed cancel
        Application.ScreenUpdating = False
        For FileIndex = 1 To .SelectedItems.Count
            With Workbooks.Open(.SelectedItems(FileIndex))
                Set rngFound = .Sheets(1).Cells.Find("Charge To", .Sheets(1).Range("A1"), xlValues, xlWhole)
                If Not rngFound Is Nothing Then
                    strPeriod = Trim(Left(.Sheets(1).Range("F3").Text, InStr(1, .Sheets(1).Range("F3").Text, "-", vbTextCompare) - 1))
                    dtStart = CDate(Trim(Mid(.Sheets(1).Range("F3").Text, InStr(1, .Sheets(1).Range("F3").Text, "-", vbTextCompare) + 1)))
                    strFirst = rngFound.Address
                    Do
                        strName = rngFound.Offset(-1).Text
                        dtDate = dtStart
                        For Each rngDate In Intersect(rngFound.EntireRow, .Sheets(1).Range("C:N")).Cells
                            If InStr(1, strChecked, rngDate.MergeArea.Address, vbTextCompare) = 0 Then
                                strChecked = strChecked & " " & rngDate.MergeArea.Address & " "
                                For Each rngCharge In Intersect(Range(rngFound.Offset(1), rngFound.End(xlDown).Offset(-4)).EntireRow, .Sheets(1).Columns(rngDate.Column)).Cells
                                    If Len(Trim(rngCharge.Value)) > 0 And rngCharge.Value > 0 Then
                                        strChargeTo = .Sheets(1).Cells(rngCharge.Row, rngFound.Column).Text
                                        DataIndex = DataIndex + 1
                                        arrData(DataIndex, 1) = strName
                                        arrData(DataIndex, 2) = strPeriod
                                        arrData(DataIndex, 3) = dtDate
                                        arrData(DataIndex, 4) = rngCharge.Value
                                        arrData(DataIndex, 5) = strChargeTo
                                    End If
                                Next rngCharge
                                dtDate = dtDate + 1
                            End If
                        Next rngDate
                        Set rngFound = .Sheets(1).Cells.Find("Charge To", rngFound, xlValues, xlWhole)
                    Loop While rngFound.Address <> strFirst
                    Set rngFound = Nothing
                    strFirst = vbNullString
                    strName = vbNullString
                    strChecked = vbNullString
                End If
                .Close False
            End With
        Next FileIndex
        Application.ScreenUpdating = True
    End With
    
    If DataIndex > 0 Then
        With Sheets.Add
            With .Range("A1:E1")
                .Value = Array("Employee Name", "Period", "Date", "Time", "Charge To")
                .Font.Bold = True
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
            End With
            .Range("A2:E2").Resize(DataIndex).Value = arrData
            .UsedRange.Sort .Range("A1"), xlAscending, .Range("C1"), , xlAscending, .Range("E1"), xlAscending, xlYes
            .Range("A:D").EntireColumn.AutoFit
        End With
    End If
    
    Set rngFound = Nothing
    Set rngDate = Nothing
    Set rngCharge = Nothing
    Erase arrData
    
End Sub