Function SolvePolyR(ParamArray CoeffA() As Variant) As Variant

'SolvePolyR - works as SolvePoly to find the roots of any polynomial but returns only real roots

Dim i As Long, j As Long
Dim PArray As Variant, PArray2 As Variant
Dim Num_Coeff As Long
Dim vtype As Long
Dim n_1 As Long, n_2 As Long
Dim Res As Variant
Dim Numreal As Long
Dim RRes As Variant

    vtype = VarType(CoeffA(0))
    If vtype = 8204 Then
        PArray = CoeffA(0).Value2
        If UBound(PArray) = 1 Then PArray = Transpose1(PArray)
        Num_Coeff = UBound(PArray)
        n_2 = UBound(CoeffA)
        If n_2 > 0 Then
            n_1 = Num_Coeff
            Num_Coeff = n_1 + n_2
            ReDim PArray2(1 To Num_Coeff, 1 To 1)
            For i = 1 To n_1
                PArray2(i, 1) = PArray(i, 1)
            Next i
            j = n_1 + 1
            For i = 1 To n_2
                If IsNumeric(CoeffA(i)) Then
                    PArray2(j, 1) = CoeffA(i)
                Else
                    PArray2(j, 1) = CoeffA(i).Value2
                End If
                j = j + 1
            Next i
            PArray = PArray2
        End If
    Else
        Num_Coeff = UBound(CoeffA) + 1
        ReDim PArray(1 To Num_Coeff, 1 To 1)
        For i = 0 To Num_Coeff - 1
            If IsNumeric(CoeffA(i)) Then
                PArray(i + 1, 1) = CoeffA(i)
            Else
                PArray(i + 1, 1) = CoeffA(i).Value2
            End If
        Next i
    End If

    Select Case Num_Coeff
        Case Is < 3
            SolvePolyR = "Num_Coeff must be >= 3"
            Exit Function
        Case Is < 4
            Res = Quadratic(PArray)
        Case 4
            Res = CubicC(PArray)
        Case 5
            Res = Quartic(PArray)
        Case Else
            Res = RPolyJT(PArray)
    End Select
    Numreal = Res(Num_Coeff, 1)

    If Numreal = 0 Then
        SolvePolyR = "No real roots"
        Exit Function
    End If

    ReDim RRes(1 To 1, 1 To Numreal)

    For i = 1 To Numreal
        RRes(1, i) = Res(i, 1)
    Next i

    SolvePolyR = RRes
End Function