Excel VBA Display Nearest Three Lines to a Point

I am attempting to create a sub or fun to perform the below:
Pull data from two different sheets (Fiber and Lights)
Run a loop comparing the coordinates from Lights to the set of coordinates from Fiber (creates a line)
Save the IDs of the three nearest Fiber lines for each set of light coordinates
Display the IDs of the three nearest lines on the Lights Sheet
Data from worksheet 1 are in the following columns:
X1 = C
Y1 = D
X2 = E
X3 = F
dxl = G
dyl = H
Data from worksheet 2 are in the following columns
pX = H
pY = I
(Data to be calculated)
near = M
mid = N
far = O
I currently have the following code which does not have errors but also does not display the data in columns M,N, and O.
Sub streetLight()
‘ Declare Variables
    Dim dxc As Double
    Dim dyc As Double
    Dim dxl As Double
    Dim dyl As Double
    Dim f As Integer
    Dim s As Integer
    Dim near As Double
    Dim mid As Double
    Dim far As Double
    Dim nearID As Double
    Dim midID As Double
    Dim farID As Double
    Dim cross As Double
    Dim currentID As Double
    Dim finalRowF As Integer
    Dim finalRowS As Integer
    Dim X1 As Double
    Dim X2 As Double
    Dim Y1 As Double
    Dim Y2 As Double
    Dim pX As Double
    Dim pY As Double
‘ Set high margins for data to be collected
    near = 5
    mid = 5
    far = 5
‘ Clear sheet and set limits
finalRowF = Sheets(“Fiber”).Range(“A900”).End(xlUp).Row
finalRowS = Sheets(“Lights”).Range(“A900”).End(xlUp).Row
‘ Initialize Lights sheet loop
 For s = 2 To finalRowS
    pX = ThisWorkbook.Sheets(“Sheet2”).Range(H2).Value
    pY = Sheets(“Lights”).Range(2, 9).Value
‘ Initialize Fiber sheet loop (to compare each value from Lights to each value in Fiber)
    For f = 3 To finalRowF
        dxc = Sheets(“Fiber”).Range(f, 7).Value
        dyc = Sheets(“Fiber”).Range(f, 8).Value
        X1 = Sheets(“Fiber”).Range(f, 3).Value
        Y1 = Sheets(“Fiber”).Range(f, 4).Value
        X2 = Sheets(“Fiber”).Range(f, 5).Value
        Y2 = Sheets(“Fiber”).Range(f, 6).Value
        currentID = Sheets(“Fiber”).Range(f, 1).Value
‘ Run distance calculation
        dxl = X2 – X1
        dyl = Y2 – Y1
        cross = dxc * dyl – dyc * dxl
‘ Review distance result and display data if required (looking for nearest three Fiber lines to Light)
        If (cross < near) Then
            near = cross
            mid = near
            far = mid
            nearID = currentID
            midID = nearID
            farID = midID
            Sheets(“Lights”).Range(Cells(s, 14)).Copy
            Sheets(“Lights”).Range(Cells(s, 15)).PasteSpecial x1PasteFormulasAndNumberFormats
            Sheets(“Lights”).Range(Cells(s, 13)).Copy
            Sheets(“Lights”).Range(Cells(s, 14)).PasteSpecial x1PasteFormulasAndNumberFormats
            Sheets(“Fiber”).Range(Cells(f, 1)).Copy
            Sheets(“Lights”).Range(Cells(s, 13)).PasteSpecial x1PasteFormulasAndNumberFormats
        ElseIf (near < cross < mid) Then
            mid = cross
            far = mid
            midID = currentID
            farID = midID
            Sheets(“Lights”).Range(Cells(s, 14)).Copy
            Sheets(“Lights”).Range(Cells(s, 15)).PasteSpecial x1PasteFormulasAndNumberFormats
            Sheets(“Fiber”).Range(Cells(f, 1)).Copy
            Sheets(“Lights”).Range(Cells(s, 14)).PasteSpecial x1PasteFormulasAndNumberFormats
        ElseIf (mid < cross < far) Then
            far = cross
            farID = currentID
            Sheets(“Fiber”).Range(Cells(f, 1)).Copy
            Sheets(“Lights”).Range(Cells(s, 15)).PasteSpecial x1PasteFormulasAndNumberFormats
        End If
    Next f
 Next s

End Sub

Do let me know if you need sample data or have questions.
Thank you for your help!!
Make it an excellent day,
Brandt H

By: Brandt Holmes

154 thoughts on “Excel VBA Display Nearest Three Lines to a Point

Leave a Reply

Your email address will not be published. Required fields are marked *