Option Explicit
Dim Xarr() As Variant, Yarr() As Variant, Zarr() As Variant
Public Sub LoadChartData(AxisName As String)
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 & "\"
Set SourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(SourceFolder).Files
For Each sourceFile In SourceFiles
If sourceFile.Name Like "*.xlsx" Then
If InStr(sourceFile.Name, "Random") = 0 Then
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
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
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
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
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
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
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
For Each S In Sheets("Sheet1").ChartObjects("Chart 1").Chart.SeriesCollection
S.Delete
Next S
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)
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
SeriesList = Array("Control", "X-Response", "Y-Response", "Z-Response")
If ChtType = "Pre Sine" Then
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
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
For Cnt = First To Last
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
.SeriesCollection.NewSeries
.SeriesCollection(Cnt).XValues = TempXArr
.SeriesCollection(Cnt).Values = TempYArr
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
.SeriesCollection(Cnt).Border.Weight = xlMedium
.SeriesCollection(Cnt).Border.LineStyle = xlContinuous
.SeriesCollection(Cnt).MarkerStyle = xlMarkerStyleNone
Next Cnt
.HasLegend = True
.Legend.Position = xlLegendPositionBottom
.Legend.AutoScaleFont = True
.HasTitle = True
.ChartTitle.AutoScaleFont = False
.ChartTitle.Characters.Text = ChrtTitle
.ChartTitle.Characters.Font.Size = 12
End With
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
With Sheets("Sheet1").ChartObjects("Chart 1").Chart.Axes(xlCategory)
.MinimumScale = 20
.MaximumScale = 2000
.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