Speed up my VBA using arrays - arrays

Question

I have hobby programmed this a VBA macro for extracting and plotting data from some text files in Excel. I recentyl tried it on a slightly bigger file, about 700 lines and 1 too three rows to be averaged and plotted. It is painfully slow and i think it can be inproved using arrays but my previous atempt at usings arrays in VBA was not very successfull so i thought i would ask you guys for some advice on how to turn the following code from a for loop into a array addition.
Here is the part I want to convert. Basically it goes line to line and averages the values from a specific but unknown number of columns.
' Add all Stribeckcurves
l = 8
For k = skriv + 4 To skriv + 45
meanSpeed = 0
meanTraction = 0
For m = 1 To NumberOfColumns
meanSpeed = meanSpeed + shtraw.Cells(k, i + 2 * m - 2)
meanTraction = meanTraction + shtraw.Cells(k, i + 2 * m - 1)
Next m
shtmean.Cells(l, 3 * j - 2) = meanSpeed / NumberOfColumns
shtmean.Cells(l, 3 * j - 1) = meanTraction / NumberOfColumns
l = l + 1
Next k
Here i the whole code block for reference:
Sub loppthroughfolder()
Dim mainwb As Workbook, Datwb As Workbook, filename As String, arrFileName() As String, shtraw As Worksheet, shtmean As Worksheet, lastrow As Long, lastColumn As Long, j As Integer, profile As String, duplicateArray As Variant, meanSpeed As Double, meanTraction As Double
Set mainwb = ActiveWorkbook
Worksheets("rawData").Cells.Clear
Worksheets("mean").Cells.Clear
Charts("plot").Activate
For Each s In ActiveChart.SeriesCollection
s.Delete
Next s
Set shtraw = ThisWorkbook.Worksheets("rawData")
Set shtmean = ThisWorkbook.Worksheets("mean")
Set shtcon = ThisWorkbook.Worksheets("configure")
Set shtplot = ThisWorkbook.Charts("plot")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1)
End With
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set folderObj = fileSystemObject.getfolder(MyFolder)
shtraw.Select
For Each fileObj In folderObj.Files 'loop through files
If (fileSystemObject.GetExtensionName(fileObj.Path) = "txt") Then
If Not fileObj.Attributes And 2 Then
arrFileName = Split(fileObj.Path, "\")
Path = "TEXT:" & fileObj.Path
filename = arrFileName(UBound(arrFileName))
'Get the filename without the.mtmd
CustName = Mid(filename, 1, InStr(filename, ".") - 1)
range("$A$1").value = CustName
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileObj.Path, Destination:=range("$A$2"))
.name = filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If 'end if hidden if statement
End If 'end of txt
Next fileObj 'close loop
range("$A$1:$B$1").Delete shift:=xlToLeft
lastrow = shtraw.UsedRange.Rows.Count
lastColumn = shtraw.UsedRange.Columns.Count
' Some formating before the sorting
For i = 1 To lastColumn Step 2
shtraw.Cells(9, i + 1) = shtraw.Cells(9, i)
Next i
' Sort the result after the second line in the comments
shtraw.Sort.SortFields.Clear
shtraw.Sort.SortFields.Add Key:=range(shtraw.Cells(9, 1), shtraw.Cells(9, lastColumn)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With shtraw.Sort
.SetRange range(Cells(1, 1), Cells(lastrow, lastColumn))
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.Apply
End With
duplicateArray = findCopies(shtraw, lastColumn)
j = 1
For Each i In duplicateArray
' Find out how many columns there are for this FM
If j = UBound(duplicateArray) + 1 Then
NumberOfColumns = (lastColumn + 1 - duplicateArray(j - 1)) / 2
Else
NumberOfColumns = (duplicateArray(j) - duplicateArray(j - 1)) / 2
End If
' Find out how many rows of comments there are
commentsEnd = findFunc("rawData", i, "Number of steps in profile:", 0, "top") - 1
' Add the test name and sample name
shtmean.Cells(1, 3 * j - 2) = shtraw.Cells(1, i)
shtmean.Cells(2, 3 * j - 2) = shtraw.Cells(6, i + 1)
' Add all row of comments
l = 3
For k = 8 To commentsEnd
shtmean.Cells(l, 3 * j - 2) = shtraw.Cells(k, i)
l = l + 1
Next k
' Extract the profile name
profile = Mid(shtraw.Cells(4, i + 1).value, InStrRev(shtraw.Cells(4, i + 1).value, "Profiles\") + 9, InStrRev(shtraw.Cells(4, i + 1).value, "."))
shtmean.Cells(5, 3 * j - 2) = Mid(profile, 1, InStr(profile, ".") - 1)
' Add the time and date the test started
shtmean.Cells(6, 3 * j - 2) = Mid(shtraw.Cells(12, i).value, InStrRev(shtraw.Cells(12, i).value, "at") + 3)
' Find the last Stribeck curve
skriv = findFunc("rawData", i + 1, shtcon.Cells(9, 2), lastrow, "bottom")
' Time step or Stribeck curve
If shtcon.Cells(9, 2) = "STRIBECK" Then
' Add all Stribeckcurves
l = 8
For k = skriv + 4 To skriv + 45
meanSpeed = 0
meanTraction = 0
For m = 1 To NumberOfColumns
meanSpeed = meanSpeed + shtraw.Cells(k, i + 2 * m - 2)
meanTraction = meanTraction + shtraw.Cells(k, i + 2 * m - 1)
Next m
shtmean.Cells(l, 3 * j - 2) = meanSpeed / NumberOfColumns
shtmean.Cells(l, 3 * j - 1) = meanTraction / NumberOfColumns
l = l + 1
Next k
ElseIf shtcon.Cells(9, 2) = "BOD_TIMED" Then
l = 8
For k = skriv + 4 To skriv + 723
meanSpeed = 0
meanTraction = 0
For m = 1 To NumberOfColumns
meanSpeed = meanSpeed + shtraw.Cells(k, i + 2 * m - 2)
meanTraction = meanTraction + shtraw.Cells(k, i + 2 * m - 1)
Next m
shtmean.Cells(l, 3 * j - 2) = meanSpeed / NumberOfColumns
shtmean.Cells(l, 3 * j - 1) = meanTraction / NumberOfColumns
l = l + 1
Next k
Else
MsgBox "Skriv STRIBECK eller BOD_TIMED"
Exit Sub
End If
' Plot it
With Charts("plot")
.ChartType = xlXYScatterSmooth
.SeriesCollection.NewSeries
.SeriesCollection(j).name = shtmean.Cells(4, 3 * j - 2)
.SeriesCollection(j).XValues = range(shtmean.Cells(8, 3 * j - 2), shtmean.Cells(l - 1, 3 * j - 2))
.SeriesCollection(j).Values = range(shtmean.Cells(8, 3 * j - 1), shtmean.Cells(l - 1, 3 * j - 1))
.SeriesCollection(j).Format.Fill.Visible = msoFalse
.SeriesCollection(j).Format.Line.Visible = msoFalse
End With
j = j + 1
Next i
' Edit plot
If shtcon.Cells(9, 2) = "STRIBECK" Then
With Charts("plot")
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Speed (mm/s)"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Friction coefficient"
'Scale Axis
.Axes(xlCategory).ScaleType = xlLogarithmic
.Axes(xlCategory).MinimumScale = 4.5
.Axes(xlCategory).MaximumScale = 3500
End With
ElseIf shtcon.Cells(9, 2) = "BOD_TIMED" Then
With Charts("plot")
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (s)"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Friction coefficient"
'Scale Axis
.Axes(xlCategory).ScaleType = xlScaleLinear
.Axes(xlCategory).MinimumScale = 10
.Axes(xlCategory).MaximumScale = 7200
End With
End If
With Charts("plot")
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Speed (mm/s)"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Friction coefficient"
'Scale Axis
.Axes(xlCategory).ScaleType = xlLogarithmic
.Axes(xlCategory).MinimumScale = 4.5
.Axes(xlCategory).MaximumScale = 3500
End With
ActiveWorkbook.Save
End Sub
Thank you very much for any input on this problem.
Best regards,
Rikard

Answer 1

I'm not sure that converting to arrays will help all that much.
A quick win will be to switch off calculation for the entire process:
Application.Calculation = xlCalculationManual
Don't forget to switch it back on again once you're done.
You can also switch off screen updating: Application.ScreenUpdating = False, but that doesn't improve things too much normally.
That all said, there's nothing in your VBA that can't be done directly on a worksheet with the built-in Excel formulas. That's probably best in terms of performance.