CODE --> VBA

Public Function geo_line_complex_intersect(xy_line_1 As Variant, xy_line_2 As Variant, Optional compact_results As Boolean = True) As Variant
'function to return all XY intersections between two defined continuous lines or broken lines
'leave blank rows or #NA between line coordinates to use individual unconnected lines as inputs

'create array from input data
    xy_line_1 = array_convert_rng_to_array(xy_line_1)
    xy_line_2 = array_convert_rng_to_array(xy_line_2)

    On Error GoTo 0
    Dim line_1_count As Long
    Dim line_2_count As Long
    Dim i As Long
    Dim count_x As Long
    Dim count_y As Long
    Dim x1_line_1 As Double
    Dim x2_line_1 As Double
    Dim x1_line_2 As Double
    Dim x2_line_2 As Double
    Dim y1_line_1 As Double
    Dim y2_line_1 As Double
    Dim y1_line_2 As Double
    Dim y2_line_2 As Double
    Dim xy_intersection(1 To 1, 1 To 2) As Variant
    Dim xy_intersection_results As Variant
    Dim x_intersection As Double
    Dim y_intersection As Double
    Dim line_1_segment(1 To 2, 1 To 2)
    Dim line_2_segment(1 To 2, 1 To 2)
    Dim temp

    'replace any #NA errors with equivalent of 'Empty'/vbNullString
    xy_line_1 = array_replace_errors(xy_line_1)
    xy_line_2 = array_replace_errors(xy_line_2)

    'loop through first line line segments and check for intersections with all segments of second line
    For line_1_count = 1 To UBound(xy_line_1) - 1
        'create line 1 segment array
        line_1_segment(1, 1) = xy_line_1(line_1_count, 1)
        line_1_segment(2, 1) = xy_line_1(line_1_count + 1, 1)
        line_1_segment(1, 2) = xy_line_1(line_1_count, 2)
        line_1_segment(2, 2) = xy_line_1(line_1_count + 1, 2)

        'check if line 1 segment includes blank/empty coordinate rows, and skip processing this line segment
        If array_value_in_array(vbNullString, line_1_segment) Then GoTo skip_line_1

        For line_2_count = 1 To UBound(xy_line_2) - 1
            'create line 2 segment array
            line_2_segment(1, 1) = xy_line_2(line_2_count, 1)
            line_2_segment(2, 1) = xy_line_2(line_2_count + 1, 1)
            line_2_segment(1, 2) = xy_line_2(line_2_count, 2)
            line_2_segment(2, 2) = xy_line_2(line_2_count + 1, 2)

            'check if line 2 segment includes blank/empty coordinate rows, and skip processing this line segment
            If array_value_in_array(vbNullString, line_2_segment) Then GoTo skip_line_2

            'check and determine intersection point coordinates
            temp = geo_line_intersect(line_1_segment, line_2_segment)

            'create intersection coordinates results array
            If i = 0 Then
                'first intersection
                xy_intersection(1, 1) = temp(0)
                xy_intersection(1, 2) = temp(1)
                xy_intersection_results = xy_intersection
                i = 1
            Else
                'subsequent intersections
                xy_intersection(1, 1) = temp(0)
                xy_intersection(1, 2) = temp(1)
                xy_intersection_results = CombineArrays(xy_intersection_results, xy_intersection)
            End If
skip_line_2:
        Next line_2_count
skip_line_1:
    Next line_1_count

    'compact results removing any #NA rows/results
    If compact_results Then
        xy_intersection_results = array_remove_error_rows(xy_intersection_results)
    End If

    'return results
    geo_line_complex_intersect = xy_intersection_results

End Function

Public Function geo_line_intersect(xy_line_1 As Variant, xy_line_2 As Variant) As Variant
'test to determine if two lines intersect based on XY coordinates, returns XY coordinate of intersection point if
'line segments cross each other. Otherwise returns NA errors
'Refer https://en.wikipedia.org/wiki/Line-line_intersection

'create array from input data
    xy_line_1 = array_convert_rng_to_array(xy_line_1)
    xy_line_2 = array_convert_rng_to_array(xy_line_2)

    'setup variables for individual points
    Dim x1_line_1 As Double
    Dim x2_line_1 As Double
    Dim x1_line_2 As Double
    Dim x2_line_2 As Double
    Dim y1_line_1 As Double
    Dim y2_line_1 As Double
    Dim y1_line_2 As Double
    Dim y2_line_2 As Double
    Dim x_intersection As Double
    Dim y_intersection As Double

    Dim t As Double
    Dim u As Double
    Dim denominator As Double

    'read individual points coords
    x1_line_1 = xy_line_1(1, 1)
    x2_line_1 = xy_line_1(2, 1)
    x1_line_2 = xy_line_2(1, 1)
    x2_line_2 = xy_line_2(2, 1)
    y1_line_1 = xy_line_1(1, 2)
    y2_line_1 = xy_line_1(2, 2)
    y1_line_2 = xy_line_2(1, 2)
    y2_line_2 = xy_line_2(2, 2)

    'denominator, if denominator is zero then lines are parallel
    denominator = (x1_line_1 - x2_line_1) * (y1_line_2 - y2_line_2) - (y1_line_1 - y2_line_1) * (x1_line_2 - x2_line_2)

    If denominator <> 0 Then
        'lines are not parallel
        t = ((x1_line_1 - x1_line_2) * (y1_line_2 - y2_line_2) - (y1_line_1 - y1_line_2) * (x1_line_2 - x2_line_2)) / denominator
        u = -((x1_line_1 - x2_line_1) * (y1_line_1 - y1_line_2) - (y1_line_1 - y2_line_1) * (x1_line_1 - x1_line_2)) / denominator
    Else
        'line segments are parallel
        geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
        Exit Function
    End If

    'check if lines intersect
    If u >= 0 And u <= 1 And t >= 0 And t <= 1 Then
        'line segments do intersect
        'intersection point coordinates
        x_intersection = x1_line_1 + t * (x2_line_1 - x1_line_1)
        y_intersection = y1_line_1 + t * (y2_line_1 - y1_line_1)
        geo_line_intersect = Array(x_intersection, y_intersection)
    Else
        'line segments do not intersect
        geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
    End If

End Function

Public Function array_remove_error_rows(arr As Variant) As Variant
'Function to remove rows that contain an error in array

    arr = array_convert_rng_to_array(arr)

    Dim temp_arr As Variant
    Dim valid_count As Long
    Dim row_count As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim col_count As Long
    Dim col_loop As Long
    Dim col1 As Long
    Dim col2 As Long

    'establish array limits for 1st and 2nd dimensions
    row1 = LBound(arr, 1)
    row2 = UBound(arr, 1)
    col1 = LBound(arr, 2)
    col2 = UBound(arr, 2)

    'determine number of valid points and write to array removing #NA results
    valid_count = LBound(arr, 1) - 1

    For row_count = row1 To row2
        For col_count = col1 To col2
            If IsError(arr(row_count, col_count)) Then
                GoTo skip_row
            End If
            'at end of row (at last column) execute following if there were no errors in the row of data and
            're-write entire row values to new row position
            If col_count = col2 Then    'last column
                valid_count = valid_count + 1
                'loop through all columns at current row and populate values to new position
                For col_loop = col1 To col2
                    arr(valid_count, col_loop) = arr(row_count, col_loop)
                Next col_loop
            End If
        Next col_count
skip_row:
    Next row_count

    'resize results array to remove trailing #NA results
    temp_arr = arr
    ReDim arr(row1 To valid_count, col1 To col2)
    For row_count = row1 To valid_count
        For col_count = col1 To col2
            arr(row_count, col_count) = temp_arr(row_count, col_count)
        Next col_count
    Next row_count

    'return results
    array_remove_error_rows = arr

End Function

Public Function array_value_in_array(value_to_be_found As Variant, arr As Variant) As Boolean
'Function to check if a value is in an array of values

    Dim element As Variant
    On Error GoTo error_handling:
    For Each element In arr
        If element = value_to_be_found Then
            array_value_in_array = True
            Exit Function
        End If
    Next element
    Exit Function
error_handling:
    On Error GoTo 0
    array_value_in_array = False

End Function

Function array_convert_rng_to_array(arr As Variant)
'function to convert ranges to arrays

    Dim temp As Variant
    'if already an array exit function returning same array
    If IsArray(arr) Then
        array_convert_rng_to_array = arr
        Exit Function
    End If

    'convert range input into array
    If arr.Columns.Count = 1 And arr.Rows.Count = 1 Then
        temp = arr.Value2
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = temp
        array_convert_rng_to_array = arr
    Else
        array_convert_rng_to_array = arr.Value2
    End If

End Function

Public Function array_replace_errors(arr As Variant) As Variant
'Function to replace all array values that are errors with 'Empty'/check if a value is in an array of values

    arr = array_convert_rng_to_array(arr)

    Dim row_count As Long
    Dim col_count As Long

    'loop through all elements in array and replace any errors with 'Empty'/vbNullString
    For row_count = LBound(arr, 1) To UBound(arr, 1)
        For col_count = LBound(arr, 2) To UBound(arr, 2)
            If IsError(arr(row_count, col_count)) Then arr(row_count, col_count) = vbNullString
        Next col_count
    Next row_count

    'return results
    array_replace_errors = arr

End Function

Function CombineArrays(a As Variant, b As Variant, Optional stacked As Boolean = True) As Variant
'assumes that A and B are 2-dimensional variant arrays
'if stacked is true then A is placed on top of B
'in this case the number of rows must be the same,
'otherwise they are placed side by side A|B
'in which case the number of columns are the same
'LBound can be anything but is assumed to be
'the same for A and B (in both dimensions)
'False is returned if a clash

    Dim lb As Long, m_A As Long, n_A As Long
    Dim m_B As Long, n_B As Long
    Dim m As Long, n As Long
    Dim i As Long, j As Long, k As Long
    Dim c As Variant

    If TypeName(a) = "Range" Then a = a.Value
    If TypeName(b) = "Range" Then b = b.Value

    lb = LBound(a, 1)
    m_A = UBound(a, 1)
    n_A = UBound(a, 2)
    m_B = UBound(b, 1)
    n_B = UBound(b, 2)

    If stacked Then
        m = m_A + m_B + 1 - lb
        n = n_A
        If n_B <> n Then
            CombineArrays = False
            Exit Function
        End If
    Else
        m = m_A
        If m_B <> m Then
            CombineArrays = False
            Exit Function
        End If
        n = n_A + n_B + 1 - lb
    End If
    ReDim c(lb To m, lb To n)
    For i = lb To m
        For j = lb To n
            If stacked Then
                If i <= m_A Then
                    c(i, j) = a(i, j)
                Else
                    c(i, j) = b(lb + i - m_A - 1, j)
                End If
            Else
                If j <= n_A Then
                    c(i, j) = a(i, j)
                Else
                    c(i, j) = b(i, lb + j - n_A - 1)
                End If
            End If
        Next j
    Next i
    CombineArrays = c
End Function