Reputation: 3
I'm trying to get my VBA code to output a graph in excel based on an inputted range that was selected using a user defined function from multiple cells. I've passed the data to the sub as a range but it ends up assuming that the range is two data sets rather than one data set with x and y values. The data set is selected from excel into a function that is being written separately which then calls the sub.
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2
cht.Chart.SetSourceData Source:=r
cht.Chart.ChartType = xlXYScatterLines
End Sub
I called the sub through
Call CreateChart(r)
with r being a two column range of data that was selected from excel.
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
The overall function code is here as well
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
Dim data() As Double
Dim check1 As Integer
Dim Smatrix() As Double
Dim Tmatrix() As Double
Dim Xmatrix() As Double
Dim Amatrix() As Double
Dim Hmatrix() As Double
Dim m As Integer
Dim i As Integer
m = r.Rows.Count
ReDim data(1 To m, 2)
ReDim Smatrix(1 To m, 1 To m)
ReDim Tmatrix(1 To m, 4)
ReDim Xmatrix(1 To m)
ReDim Amatrix(1 To m - 1, 1 To 4)
ReDim Hmatrix(1 To m)
check1 = Test(check)
For i = 1 To m
data(i, 1) = r(i, 1).Value
data(i, 2) = r(i, 2).Value
Next i
Smatrix(1, 1) = 1
Smatrix(m, m) = 1
For i = 1 To m - 1
Hmatrix(i) = data(i + 1, 1) - data(i, 1)
Next i
If check1 = 2 Then
Smatrix(1, 2) = -1
Smatrix(m, m - 1) = -1
End If
For i = 2 To m - 1
Smatrix(i, i - 1) = Hmatrix(i - 1)
Smatrix(i, i + 1) = Hmatrix(i)
Smatrix(i, i) = 2 * (Hmatrix(i - 1) + Hmatrix(i))
Next i
For i = 2 To m - 1
Tmatrix(i, 4) = 6 * ((data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - (data(i, 2) - data(i - 1, 2)) / Hmatrix(i - 1))
Next i
For i = 1 To m
If i <> 1 Then
Tmatrix(i, 1) = Smatrix(i, i - 1)
End If
Tmatrix(i, 2) = Smatrix(i, i)
If i <> m Then
Tmatrix(i, 3) = Smatrix(i, i + 1)
End If
Next i
For i = 2 To m
Tmatrix(i, 1) = Tmatrix(i, 1) / Tmatrix(i - 1, 2)
Tmatrix(i, 2) = Tmatrix(i, 2) - Tmatrix(i, 1) * Tmatrix(i - 1, 3)
Tmatrix(i, 4) = Tmatrix(i, 4) - Tmatrix(i, 1) * Tmatrix(i - 1, 4)
Next i
Xmatrix(m) = Tmatrix(m, 4) / Tmatrix(m, 2)
For i = m - 1 To 1 Step -1
Xmatrix(i) = (Tmatrix(i, 4) - Tmatrix(i, 3) * Xmatrix(i + 1)) / Tmatrix(i, 2)
Next i
For i = 1 To m - 1
Amatrix(i, 1) = (Xmatrix(i + 1) - Xmatrix(i)) / 6 * Hmatrix(i)
Amatrix(i, 2) = Xmatrix(i) / 2
Amatrix(i, 3) = (data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - Hmatrix(i) * Xmatrix(i) / 2 - Hmatrix(i) * (Xmatrix(i + 1) - Xmatrix(i)) / 6
Amatrix(i, 4) = data(i, 2)
Next i
If x < data(1, 1) Or x > data(m, 1) Then
Call Check2(x)
If x < data(1, 1) Then
cubic = Amatrix(1, 1) * (x - data(1, 1)) ^ 3 + Amatrix(1, 2) * (x - data(1, 1)) ^ 2 + Amatrix(1, 3) * (x - data(1, 1)) + Amatrix(1, 4)
ElseIf x > data(m, 1) Then
cubic = Amatrix(m - 1, 1) * (x - data(m - 1, 1)) ^ 3 + Amatrix(m - 1, 2) * (x - data(m - 1, 1)) ^ 2 + Amatrix(m - 1, 3) * (x - data(m - 1, 1)) + Amatrix(m - 1, 4)
End If
ElseIf x = data(m, 1) Then
cubic = data(m, 2)
Else
For i = 1 To m - 1
If data(i, 1) < x And x < data(i + 1, 1) Then
cubic = Amatrix(i, 1) * (x - data(i, 1)) ^ 3 + Amatrix(i, 2) * (x - data(i, 1)) ^ 2 + Amatrix(i, 3) * (x - data(i, 1)) + Amatrix(i, 4)
ElseIf x = data(i, 1) Then
cubic = data(i, 2)
End If
Next i
End If
Call CreateChart(r)
End Function
As well as the subroutine and function called within the function that haven't been posted
Public Function Test(check As Integer) As Integer
Dim Response As Integer
If check = 1 Then
Response = MsgBox("Boundary Condition 1 selected, is this correct (select No for boundary condition 2)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
ElseIf check = 2 Then
Response = MsgBox("Boundary Condition 2 selected, is this correct (select No for boundary condition 1)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 2
Else
Test = 1
End If
Else
Response = MsgBox("Incorrect Boundary Condition, select Yes for condition 1 and No for condition 2", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
End If
End Function
Public Sub Check2(x)
MsgBox ("Value given is outside data range, answer may not be correct, extrapolating from calculated polynomial")
End Sub
Upvotes: 0
Views: 58
Reputation: 2875
Try
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2(XlChartType:=xlXYScatterSmooth)
cht.Chart.SetSourceData Source:=r
End Sub
Upvotes: 1