VBA script to calculate distance between points in a given section

[TrustedHippo]

I am trying to create a vba script to calculate distance between points (specifically line length) in a given section (ie: from x=2 to x=5 and so on) the section will be defined in a cell inside the workbook so it can be changed on the fly.

0.000000​	1.000000​
-0.027735​	0.958398​
0.000000​	2.000000​
0.027735​	1.958398​
0.000000​	3.000000​
-0.027735​	2.958397​
0.000000​	4.000000​

This is how my data points are set up, row 1 is a start point and row 2 is the end point on a line, row 3 is a start point and row 4 is an end point on a line and so on and so on. I'm not quite sure where to start besides long hand finding the distances with cell formulas and repeating. Kinda new to vba macros..

 

[fadee2]

hi,
Assuming your data is in column A of Sheet 1.

Dim lastrow As Long
lastrow = Sheets("sheet1").Range("a" & Sheets("sheet1").Rows.Count).End(xlUp).Row

For i = 1 To lastrow + 1 Step 2
  
    Sheets("sheet1").Range("c" & i + 1).Value = Sheets("sheet1").Range("a" & i).Value - Sheets("sheet1").Range("a" & i + 1).Value

Next i

The above code will make subtract your 2nd value from 1st value and paste the results in Column C.

 

[MoshiM]

Is this what you want?

Sub CAlculate_Distance()

Dim InputD() As Variant, M As Long

InputD = ActiveSheet.UsedRange.Value2

ReDim Preserve InputD(1 To UBound(InputD, 1), 1 To 3) ' UBound(InputD, 2) + 1)

On Error GoTo Skip_Entry

For M = LBound(InputD, 1) To UBound(InputD, 1) Step 2

    InputD(M, 3) = Sqr(((CDbl(InputD(M + 1, 1)) - CDbl(InputD(M, 1))) ^ 2) + ((CDbl(InputD(M + 1, 2)) - CDbl(InputD(M, 2))) ^ 2))

Skip_Entry: On Error GoTo -1

Next

On Error GoTo 0

ActiveSheet.UsedRange.Columns(3).Value2 = WorksheetFunction.Index(InputD, 0, 3)

End Sub

 

[TrustedHippo]

Thanks for the replies everyone, I'm still very uncertain and I have not yet tried your code @MoshiM. I feel it might be best to break this problem up more:

'Start1 = Sheets("Sheet1").Cells(1, 4).Value
'End1 = Sheets("Sheet1").Cells(3, 5).Value

'Sheets("Sheet1").Range("A3", Sheets("Sheet1").Range("A3").End(xlDown)).select

I have defined my start and end points based on inputed values so that it can change. I'm getting hung up on how to tell the macro to only work with values that are between start1 and end1 out of the entire data set. Start1 and End1 are for x coords so that is why I set up my range select with only the A column (X coords).
So I guess, how would I code in to use only this range of values, I'm not sure if its possible once selected for the macro to use that data. Would importing into an array be best?

 

[TrustedHippo]

Is this what you want?

Sub CAlculate_Distance()

Dim InputD() As Variant, M As Long

InputD = ActiveSheet.UsedRange.Value2

ReDim Preserve InputD(1 To UBound(InputD, 1), 1 To 3) ' UBound(InputD, 2) + 1)

On Error GoTo Skip_Entry

For M = LBound(InputD, 1) To UBound(InputD, 1) Step 2

    InputD(M, 3) = Sqr(((CDbl(InputD(M + 1, 1)) - CDbl(InputD(M, 1))) ^ 2) + ((CDbl(InputD(M + 1, 2)) - CDbl(InputD(M, 2))) ^ 2))

Skip_Entry: On Error GoTo -1

Next

On Error GoTo 0

ActiveSheet.UsedRange.Columns(3).Value2 = WorksheetFunction.Index(InputD, 0, 3)

End Sub

Tried out this code, it works for the intended purpose of solving line distances, thank you.

One bit I'm working on, is there a way to define the upper limit and lower limit based on the A column values in the array?

 

[MoshiM]

Tried out this code, it works for the intended purpose of solving line distances, thank you.

One bit I'm working on, is there a way to define the upper limit and lower limit based on the A column values in the array?

Can you give me an example?

 

[TrustedHippo]

So for instance, I would like to find just the line lengths between x=0 and x=75. Not necessarily those numbers, but an inputted integer from a cell, say Activesheet.Cell(4,4)

ideally I'm planning on setting it up to loop and have the inputted integer change each time, hence why I am keeping the entire data set in the workbook instead of filter/cutpaste to a new one and executing there, which would understandably be easier but I am trying to make it as user simple as possible. If that makes sense.

 

[MoshiM]

So for instance, I would like to find just the line lengths between x=0 and x=75. Not necessarily those numbers, but an inputted integer from a cell, say Activesheet.Cell(4,4)

ideally I'm planning on setting it up to loop and have the inputted integer change each time, hence why I am keeping the entire data set in the workbook instead of filter/cutpaste to a new one and executing there, which would understandably be easier but I am trying to make it as user simple as possible. If that makes sense.

Like this? Also ensure that you are getting your expected results.

Sub CAlculate_Distance()

Dim InputD() As Variant, M As Long, Xmin As Double, Xmax As Double

With Sheets("Sheet1")

    InputD = .UsedRange.Value2

    Xmin = .Cells(1, 4).Value
    Xmax = .Cells(3, 5).Value
  
End With

ReDim Preserve InputD(1 To UBound(InputD, 1), 1 To 3) ' UBound(InputD, 2) + 1)

On Error GoTo Skip_Entry

For M = LBound(InputD, 1) To UBound(InputD, 1) Step 2

    If (CDbl(InputD(M, 1)) >= Xmin And CDbl(InputD(M, 1)) <= Xmax) And (CDbl(InputD(M + 1, 1)) >= Xmin And CDbl(InputD(M + 1, 1)) <= Xmax) Then
  
        InputD(M, 3) = Sqr(((CDbl(InputD(M + 1, 1)) - CDbl(InputD(M, 1))) ^ 2) + ((CDbl(InputD(M + 1, 2)) - CDbl(InputD(M, 2))) ^ 2))
  
    End If
  
Skip_Entry: On Error GoTo -1

Next

On Error GoTo 0

sheets("Sheet1").UsedRange.Columns(3).Value2 = WorksheetFunction.Index(InputD, 0, 3)

End Sub

 

[TrustedHippo]

Moshi that works perfectly, didn't realize it was as easy as a "with" statement!

 

[TrustedHippo]

Like this? Also ensure that you are getting your expected results.

Sub CAlculate_Distance()

Dim InputD() As Variant, M As Long, Xmin As Double, Xmax As Double

With Sheets("Sheet1")

    InputD = .UsedRange.Value2

    Xmin = .Cells(1, 4).Value
    Xmax = .Cells(3, 5).Value
 
End With

ReDim Preserve InputD(1 To UBound(InputD, 1), 1 To 3) ' UBound(InputD, 2) + 1)

On Error GoTo Skip_Entry

For M = LBound(InputD, 1) To UBound(InputD, 1) Step 2

    If (CDbl(InputD(M, 1)) >= Xmin And CDbl(InputD(M, 1)) <= Xmax) And (CDbl(InputD(M + 1, 1)) >= Xmin And CDbl(InputD(M + 1, 1)) <= Xmax) Then
 
        InputD(M, 3) = Sqr(((CDbl(InputD(M + 1, 1)) - CDbl(InputD(M, 1))) ^ 2) + ((CDbl(InputD(M + 1, 2)) - CDbl(InputD(M, 2))) ^ 2))
 
    End If
 
Skip_Entry: On Error GoTo -1

Next

On Error GoTo 0

sheets("Sheet1").UsedRange.Columns(3).Value2 = WorksheetFunction.Index(InputD, 0, 3)

End Sub

MoshiM,

I'm using this code and thinking for simplicity I need to set it in a loop that will index the Xmin/Xmax cell over 1 row until there is no data in the adjacent cell. I assume the math would also have to index over as well. (I think the math portion could be achieved by using a for i+1 type loop but I'm not sure on the xmin/xmax. Print cells would also have to shift but again i think that could be done with a +1 loop. Am I on the right track?