Even with Arrays, UDF performance is slower than expected

I have the below UDF that opens a workbook (this workbook has extracted data from a queue within another app). I get the used range from this workbook and assign it to an array (aExtractedRange). One of the elements in this array has the workbook name that I need to open and get Application Name for each element in the array. I open the second workbook and assign the used range to a second array (aOPRange) so that search is more efficient

All of this works but as the first workbook can have 10K+ rows, it can take 30-40 seconds to perform this task. Is there anyway to make this faster? I have to work through few files a day so trying to see if I can improve the performance


Sub GetAppName()

    Set oWB = ThisWorkbook

    Dim oFSO As New FileSystemObject
    Dim oExtractedFilesFolder As Folder: Set oExtractedFilesFolder = oFSO.GetFolder(oWB.Worksheets("Info").Range("C3"))
    Dim oFile As File
    Dim aExtractedRange As Variant
    Dim iC As Long
    Dim sLastFile As String
    Dim oOPFile As File
    Dim aOPRange As Variant
    Dim sCurEFile As String
    Dim iKeyValueCol As Long, iTagsCol As Long, iAccountIDCol As Long, iSystemNameCol As Long
    Dim aAppName As Variant
    Dim iAppRow As Long
    Dim iLCol As Long

    ' Loop through all files in the specified folder
    For Each oFile In oExtractedFilesFolder.Files

        ' Check if current workbook is one of the expected workbooks
        If InStr(1, oFile.Name, "Queue Report", vbTextCompare) > 0 Then

            ' Get used range from file
            aExtractedRange = GetUsedRangeData(oFile, True, iKeyValueCol, iTagsCol)

            ' Did we get the range
            If IsArray(aExtractedRange) Then

                ' Get app name for all items in the array
                For iC = LBound(aExtractedRange) To UBound(aExtractedRange)

                    ' Set current file name
                    If InStr(1, aExtractedRange(iC, iTagsCol), ";") > 0 Then
                        sCurEFile = Left(Replace(aExtractedRange(iC, iTagsCol), "_IN", "_OP"), InStr(1, aExtractedRange(iC, 5), ";") - 1)
                        sCurEFile = Replace(aExtractedRange(iC, iTagsCol), "_IN", "_OP")
                    End If

                    ' If current file is the same as last file, skip this section as we already have the correct details in the array
                    If sLastFile <> sCurEFile Then

                        Set oOPFile = FindFile(sCurEFile, oFSO.GetFolder(oWB.Worksheets("Info").Range("C2")).Path)      ' Look for file in specified folder

                        aOPRange = GetUsedRangeData(oOPFile, False, iAccountIDCol, iSystemNameCol)      ' Get the used range from the file

                        sLastFile = sCurEFile

                    End If

                    ' Add element to app name array
                    If IsArray(aAppName) Then
                        ReDim Preserve aAppName(UBound(aAppName) + 1)
                        ReDim aAppName(0)
                    End If

                    ' Find row with specific account number
                    iAppRow = 0
                    On Error Resume Next
                    iAppRow = Application.WorksheetFunction.Match(aExtractedRange(iC, iKeyValueCol), Application.WorksheetFunction.Index(aOPRange, 0, iAccountIDCol), 0)
                    On Error GoTo 0

                    ' Set app name based on row number
                    If iAppRow > 0 Then
                        aAppName(UBound(aAppName)) = aOPRange(iAppRow, iSystemNameCol)
                        aAppName(UBound(aAppName)) = ""
                    End If


            End If

        End If


    With oWB.Worksheets("Sheet1")

        ' Copy extracted data to sheet
        .Range("A2").Resize(UBound(aExtractedRange, 1), UBound(aExtractedRange, 2)).Value = aExtractedRange

        ' Get last column
        iLCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        ' Copy app name to sheet
        .Range(ColLetter(iLCol + 1) & "2").Resize(UBound(aAppName), 1).Value = aAppName
    End With

    ' Clear objects
    Set oExtractedFilesFolder = Nothing
    Set oFSO = Nothing
    Set oFile = Nothing
End Sub

P.S.: UDF sits in a module and makes calls to some other UDF's. Happy to explain what they are if needed

Thanks in advance