Search code examples
excelvbasubroutineexcel-charts

Outputting a graph in VBA based off an inputted range


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

Solution

  • 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