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
Bookmarks