Option Explicit
Dim Xarr() As Variant, Yarr() As Variant, Zarr() As Variant
Public Sub LoadChartData(AxisName As String)
'AxisName "X","Y", or "Z"
Dim SourceFolder As String, SourceFiles As Object, sourceFile As Object
Dim WbSource As Workbook, DataWs As Worksheet, S As Series
Dim LastRow As Integer, TotRows As Integer, ArCnt As Integer
Dim RowCnt As Integer, SerCnt As Integer
On Error GoTo ErFix
Application.ScreenUpdating = False
Application.DisplayAlerts = False
SourceFolder = ThisWorkbook.Path & "\"
' Create a FileSystemObject to work with files in the folder
Set SourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(SourceFolder).Files
' Loop through each file in the folder
For Each sourceFile In SourceFiles
'only open .xlsx files
If sourceFile.Name Like "*.xlsx" Then
'don't include "Random" files
If InStr(sourceFile.Name, "Random") = 0 Then
' Open the source workbook
Set WbSource = Workbooks.Open(sourceFile.Path)
Set DataWs = WbSource.Worksheets("Customers")
With DataWs
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
TotRows = LastRow - 25
'Load files to Array
'XArr(1 to 2, 1 to 5, 1 to TotRows)
'presine(1) postsine(2); Col"B"(1), Col"G"(2), Col"I"(3), Col"K"(4), Col"M"(5); Row data 25 to Lastrow
'load X files to array
If InStr(sourceFile.Name, "X") Then
ReDim Preserve Xarr(2, 5, TotRows + 1)
If InStr(sourceFile.Name, "PreSine") Then
For RowCnt = 25 To LastRow
ArCnt = 1
Xarr(1, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Xarr(1, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
Else 'postsine
For RowCnt = 25 To LastRow
ArCnt = 1
Xarr(2, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Xarr(2, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
End If
'load Y files to array
ElseIf InStr(sourceFile.Name, "Y") Then
ReDim Preserve Yarr(2, 5, TotRows + 1)
If InStr(sourceFile.Name, "PreSine") Then
For RowCnt = 25 To LastRow
ArCnt = 1
Yarr(1, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Yarr(1, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
Else 'postsine
For RowCnt = 25 To LastRow
ArCnt = 1
Yarr(2, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Yarr(2, ArCnt, RowCnt - 24) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
End If
'load Z files to array
ElseIf InStr(sourceFile.Name, "Z") Then
ReDim Preserve Zarr(2, 5, TotRows + 1)
If InStr(sourceFile.Name, "PreSine") Then
For RowCnt = 25 To LastRow
ArCnt = 1
Zarr(1, ArCnt, RowCnt - 25) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Zarr(1, ArCnt, RowCnt - 25) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
Else 'postsine
For RowCnt = 25 To LastRow
ArCnt = 1
Zarr(2, ArCnt, RowCnt - 25) = DataWs.Cells(RowCnt, 2)
For SerCnt = 7 To 13 Step 2
ArCnt = ArCnt + 1
Zarr(2, ArCnt, RowCnt - 25) = DataWs.Cells(RowCnt, SerCnt)
Next SerCnt
Next RowCnt
End If
End If
WbSource.Close savechanges:=False
End If
End If
Next sourceFile
'remove previous series
For Each S In Sheets("Sheet1").ChartObjects("Chart 1").Chart.SeriesCollection
S.Delete
Next S
'Call ChartIt Sub for Axis Name
If AxisName = "X" Then
Call ChartIt("X Axis Test", Xarr, TotRows, "Pre Sine")
Call ChartIt("X Axis Test", Xarr, TotRows, "Post Sine")
ElseIf AxisName = "Y" Then
Call ChartIt("Y Axis Test", Yarr, TotRows, "Pre Sine")
Call ChartIt("Y Axis Test", Yarr, TotRows, "Post Sine")
Else
Call ChartIt("Z Axis Test", Zarr, TotRows, "Pre Sine")
Call ChartIt("Z Axis Test", Zarr, TotRows, "Post Sine")
End If
ErFix:
If Err.Number <> 0 Then
MsgBox "LoadChartDataError"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set SourceFiles = Nothing
End Sub
Public Sub ChartIt(ChrtTitle As String, InArr As Variant, Trows As Integer, ChtType As String)
'ChrtTitle: "X Axis Test", "Y Axis Test", or "Z Axis Test"
'InArr: Xarr, Yarr, or Zarr
'TRows: total number of data rows
'ChtType: "Pre Sine" or "Post Sine"
Dim TempXArr() As Variant, TempYArr() As Variant, SeriesList As Variant, ColourList As Variant
Dim Cnt As Integer, Cnt2 As Integer, ChtInt As Integer, First As Integer, Last As Integer
'xseries name array
SeriesList = Array("Control", "X-Response", "Y-Response", "Z-Response")
If ChtType = "Pre Sine" Then
'series colour list
ColourList = Array(3, 4, 5, 6)
ChtInt = 1
First = 1
Last = 4
Else
ColourList = Array(7, 8, 9, 10)
ChtInt = 2
First = 5
Last = 8
End If
'Xvalues from array to temp array
ReDim TempXArr(Trows + 1)
For Cnt = 1 To Trows + 1
TempXArr(Cnt) = InArr(ChtInt, 1, Cnt)
Next Cnt
With Sheets("Sheet1").ChartObjects("Chart 1").Chart
'add chart series
For Cnt = First To Last
'y values from array to temp array
ReDim TempYArr(Trows + 1)
For Cnt2 = 1 To Trows + 1
If ChtType = "Pre Sine" Then
TempYArr(Cnt2) = InArr(ChtInt, Cnt + 1, Cnt2)
Else
TempYArr(Cnt2) = InArr(ChtInt, Cnt - 3, Cnt2)
End If
Next Cnt2
'add series to chart
.SeriesCollection.NewSeries
.SeriesCollection(Cnt).XValues = TempXArr
.SeriesCollection(Cnt).Values = TempYArr
'name and colour series
If ChtType = "Pre Sine" Then
.SeriesCollection(Cnt).Name = ChtType & " " & SeriesList(Cnt - 1)
.SeriesCollection(Cnt).Border.ColorIndex = ColourList(Cnt - 1)
Else
.SeriesCollection(Cnt).Name = ChtType & " " & SeriesList(Cnt - 5)
.SeriesCollection(Cnt).Border.ColorIndex = ColourList(Cnt - 5)
End If
'format series
.SeriesCollection(Cnt).Border.Weight = xlMedium
.SeriesCollection(Cnt).Border.LineStyle = xlContinuous
.SeriesCollection(Cnt).MarkerStyle = xlMarkerStyleNone
Next Cnt
'add series legend
.HasLegend = True
.Legend.Position = xlLegendPositionBottom
.Legend.AutoScaleFont = True
'add chart title
.HasTitle = True
.ChartTitle.AutoScaleFont = False
.ChartTitle.Characters.Text = ChrtTitle
.ChartTitle.Characters.Font.Size = 12
End With
'y axis format
With Sheets("Sheet1").ChartObjects("Chart 1").Chart.Axes(xlValue)
.MinimumScale = 0.001
.MaximumScale = 10
.ScaleType = xlLogarithmic
.HasMajorGridlines = True
.MajorGridlines.Border.ColorIndex = 17
.TickLabels.AutoScaleFont = False
.TickLabels.Font.Bold = True
.TickLabels.Font.Size = 10
.HasTitle = True
.AxisTitle.Characters.Text = "Amplitude"
.AxisTitle.AutoScaleFont = False
.AxisTitle.Left = 1
.AxisTitle.Font.Size = 10
End With
'x axis format
With Sheets("Sheet1").ChartObjects("Chart 1").Chart.Axes(xlCategory)
.MinimumScale = 20 '18
.MaximumScale = 2000 '26
.ScaleType = xlLogarithmic
.HasMajorGridlines = True
.MajorGridlines.Border.ColorIndex = 17
.TickLabels.AutoScaleFont = False
.TickLabels.Font.Bold = True
.TickLabels.Font.Size = 10
.TickLabelPosition = xlTickLabelPositionLow
.HasTitle = True
.AxisTitle.Characters.Text = "Frequency"
.AxisTitle.AutoScaleFont = False
.AxisTitle.Font.Size = 10
End With
End Sub
