Code running extremely slow (20-30 minutes)

Hey guys,
I have written a few Macros since my first post on here, and they're working out pretty well. One of these Macros I am trying to run on multiple files. I have a working code but for some reason it takes a massive amount of time to run. Any suggestions or ideas on why it's so slow.
Here it is:

Private Sub CommandButton1_Click()
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim LastRow, Min, Max, StDev, Logavg As Double
Dim FileNumber As Single
Dim Sum As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(ThisWorkbook.Path)
Application.ScreenUpdating = False
   On Error Resume Next
ThisWorkbook.ActiveSheet.Cells(1, 5) = "Logger Avg."
ThisWorkbook.ActiveSheet.Cells(1, 6) = "Logger Max."
ThisWorkbook.ActiveSheet.Cells(1, 7) = "Logger Min."
ThisWorkbook.ActiveSheet.Cells(1, 8) = "Std. Dev."
FileNumber = 18
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
    For Each FileItem In SourceFolder.Files
If FileItem.Name <> ThisWorkbook.Name Then
    Workbooks.Open (ThisWorkbook.Path & Application.PathSeparator & FileItem.Name)
LastRow = Workbooks(FileItem.Name).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Row = 2
r = 2
Summ = 0
 Do
If Workbooks(FileItem.Name).Sheets(1).Cells(Row, 4) < 90 Then
    Workbooks(FileItem.Name).Sheets(1).Cells(r, 12) = 10 ^ (Workbooks(FileItem.Name).Sheets(1).Cells(Row, 4) / 10)
    Row = Row + 1
    Summ = Summ + Workbooks(FileItem.Name).Sheets(1).Cells(r, 12)
    End If
r = r + 1
    If Workbooks(FileItem.Name).Sheets(1).Cells(r, 4) = vbNullString Then
 Exit Do
 End If
    Loop
 Added = 0
 r = 2
 Added = Added + Workbooks(FileItem.Name).Sheets(1).Cells(r, 12)
N = Summ / (LastRow - 1)
Logavg = 10 * Log10(N)
    Max = Application.WorksheetFunction.Max(Workbooks(FileItem.Name).Sheets(1).Range(Cells(2, 4), Cells(LastRow, 4)).Value)
    Min = Application.WorksheetFunction.Min(Workbooks(FileItem.Name).Sheets(1).Range(Cells(2, 4), Cells(LastRow, 4)).Value)
    StDev = Application.WorksheetFunction.StDev(Workbooks(FileItem.Name).Sheets(1).Range(Cells(2, 4), Cells(LastRow, 4)).Value)

    Workbooks(FileItem.Name).Save
    Workbooks(FileItem.Name).Close
FileNumber = FileNumber + 1
End If
ActiveSheet.Cells(FileNumber, 5) = Logavg
ActiveSheet.Cells(FileNumber, 6) = Max
ActiveSheet.Cells(FileNumber, 3) = "1"
ActiveSheet.Cells(FileNumber, 9) = (Hour(Workbooks(FileItem.Name).Sheets(1).Cells(LastRow, 3))) - (Hour(Workbooks(FileItem.Name).Sheets(1).Cells(2, 3)))
ActiveSheet.Cells(FileNumber, 1) = Workbooks(FileItem.Name).Sheets(1).Cells(2, 2)
    Next FileItem
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveSheet.DisplayPageBreaks = True
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

End Sub

 Private Static Function Log10(x)



 Log10 = Log(x) / Log(10#)
 End Function

Originally Posted by sintek

Hi Biker_Seth

I am very certain that we can assist, however, be so kind and upload a sample file and explain to us what you are trying to achieve.

Thank you, I am trying to loop through a folder full of files like this one, do some processing, and extract the results. Here is an example file.