0

I have written a macro which computes x and y values. I am having trouble trying to write those values to cells on Excel.

I get #VALUE error when I try to display the values on the cell.

I have added my code below. Any suggestion about what is wrong with the code will be really helpful and appreciated?

Thanks in advance!

'Compute Points
Function ComputePoints(x1, y1, x2, y2, distance) As Double

'Calculate slope m
Dim m As Double
m = (y2 - y1) / (x2 - x1)

'Calculate intercept
Dim Intercept As Double
Intercept = y1 - m * x1

'Calculate x for distFinal
Dim message As String
Dim a As Double
Dim b As Double
Dim c As Double
Dim root1 As Double
Dim root2 As Double
Dim det As Double
Dim det1 As Double

Dim wb As Workbook
Dim ws As Worksheet
Dim x1Rng As Range
Dim x2Rng As Range
Dim yRng As Range

a = (m ^ 2 + 1)
b = 2 * (Intercept * m - m * y2 - x2)
c = x2 ^ 2 + (Intercept - y2) ^ 2 - distance ^ 2

det = ((b ^ 2) - (4 * a * c))

det1 = Sqr(det)

message = "There is no solution to your equation"

If det < 0 Then
    MsgBox message, vbOKOnly, "Error"
 Else
    root1 = Round((-b + det1) / (2 * a), 2)
    root2 = Round((-b - det1) / (2 * a), 2)
 End If

'Compute y
Dim y As Double
y = m * root2 + Intercept

' Trying to set cell values to root1, root2, y
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet9")

Set x1Rng = ws.Range("N2")
Set x2Rng = ws.Range("O2")
Set yRng = ws.Range("P2")

x1Rng.Value2 = root1
x2Rng.Value2 = root2
yRng.Value2 = y

ComputePoints = y

End Function
Dazzler
  • 380
  • 3
  • 27
  • 3
    A function called from the worksheet can't change the values of other cells. – Comintern Dec 09 '16 at 01:36
  • @Comintern thank you. Any alternative suggestions to display values calculated on to the worksheet? I tried adding a button and assigning the function to the button. But I encountered Argument not optional error. – Dazzler Dec 09 '16 at 01:40
  • 1
    Possible duplicate of [Set a cell value from a function](http://stackoverflow.com/questions/15659779/set-a-cell-value-from-a-function) – Mathieu Guindon Dec 09 '16 at 01:43
  • 1
    @Dazzler well obviously - you need to specify the parameter values. Write a parameterless `Sub` procedure that calls the function with whatever parameters it needs, and call that `Sub` procedure from that button. It wouldn't hurt to specify an explicit type for each parameter too, and they don't need to be passed `ByRef` either. `Private Function ComputePoints(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal distance As Double) As Double` should do it. – Mathieu Guindon Dec 09 '16 at 01:44
  • @Mat'sMug - Thank you for the suggestion. Will give it a go :) – Dazzler Dec 09 '16 at 01:57

1 Answers1

3

I modified your code slightly to get values directly in excel cells. You need to select 3 horizontal cells, press F2 / =, enter your formula and then press Ctrl Shift Enter to make it an array formula.

This will give you the three output values in the cells.

Function ComputePoints(x1, y1, x2, y2, distance)

    Dim results(3) As Variant ' @nightcrawler23

    'Calculate slope m
    Dim m As Double
    m = (y2 - y1) / (x2 - x1)

    'Calculate intercept
    Dim Intercept As Double
    Intercept = y1 - m * x1

    'Calculate x for distFinal
    Dim message As String
    Dim a As Double
    Dim b As Double
    Dim c As Double
    Dim root1 As Double
    Dim root2 As Double
    Dim det As Double
    Dim det1 As Double

    a = (m ^ 2 + 1)
    b = 2 * (Intercept * m - m * y2 - x2)
    c = x2 ^ 2 + (Intercept - y2) ^ 2 - distance ^ 2

    det = ((b ^ 2) - (4 * a * c))

    det1 = Sqr(det)

    message = "There is no solution to your equation"

    If det < 0 Then
        MsgBox message, vbOKOnly, "Error"
     Else
        root1 = Round((-b + det1) / (2 * a), 2)
        root2 = Round((-b - det1) / (2 * a), 2)
     End If

    'Compute y
    Dim y As Double
    y = m * root2 + Intercept

    results(1) = root1    ' @nightcrawler23
    results(2) = root2    ' @nightcrawler23
    results(3) = y        ' @nightcrawler23

    ComputePoints = results    ' @nightcrawler23

End Function

You need to add some code to output error message, when no roots are found

Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
nightcrawler23
  • 2,056
  • 1
  • 14
  • 22