vba arrays and calculations

[Westbury]

I have a macro which calculates distances based on the x,y co-ords of each data point (currently >15,000) against the x,y co-ords of a fixed point. The fixed point is selected by the user and should be considered as different each time the query is executed.

I've no array knowledge but have read enough to understand that they should speed up the calculation process. Reading the base data into an array is straightforward. I have a macro to carry out the distance calulation but would appreaciate some advice about the use of the array (or arrays) to read the x,y co-ords of the "fixed point".

Thanks,
Geoff

 

[Rick Rothstein]

It would be helpful to know where your data is located. What cells are you X-Coordinates in? What cells are your Y-Coordinates in? What cells are the X-Coordinate and Y-Coordinate of your fixed point in? Also, can you show us the code for the macro you indicated you have? Finally, exactly what output are you looking for and where did you want that output to go to?

 

[Westbury]

Rick, apologies for the late response. I started to document the process that I need but in doing so I think I can produce the code I need. I'll work on it and post the result --or a plea for help here!
thanks

 

[Westbury]

Well, I decided to look into arrays myself and found several useful articles [one in particular on YouTube is Wise Owl Tutorials part 25 - Arrays]

In my spreadsheet I have a fixed point and a list of points to be investigated. The source data is a named table “sourcedata” on worksheet “calc distance” with the x, y co-ords in columns G & H, cols A to I are in use. The x, y co-ords of the fixed point are in cells G2 & H2 of the new worksheet where the output of the calculations are placed. Each query generates a new ws with a name “origin / destination”, the sourcedata table is copied there and the distance calculations carried out. The calculation includes the distances and deleting rows that are outside a tolerance set by the user. The output of the calculations, the distance between the points, is in col J.

Here's the code I've produced. It works but happy to receive any suggestions that will improve it.

Sub array_distance_calc()

Dim WS As Worksheet

Dim Coordinates() As Variant
Dim FixedPoint(0 To 1) As Variant
Dim Distances() As Variant

Dim LastRow As Long
Dim C1 As Long
Dim i As Long

Set WS = Worksheets("calc distance")
    
    FixedPoint(0) = Cells(2, 7).value  'fixed pt lat
    FixedPoint(1) = Cells(2, 8).value  'fixed pt long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'populate Coordinates array
Coordinates = Range("G6:H" & LastRow)

C1 = UBound(Coordinates, 1)
ReDim Preserve Distances(C1)
'Get Distance calculation starts

    Dim n As Integer
    Dim earthSphereRadiusNauticalMiles As Double
    Dim kilometerConversionToMilesFactor As Double
    Dim lat1Radians, lon1Radians, lat2Radians, lon2Radians As Double
    Dim Lat1Degrees, Lat2Degrees, Lon1Degrees, Lon2Degrees As Double
    Dim AsinBase As Double
    Dim DerivedAsin As Double
    Dim Min, Max As Integer
    Dim FirstRow As Long
    
    Application.DisplayAlerts = False
    
    'Mean radius of the earth (replace with 3443.89849 to get nautical miles, 6371 to get KM)
        
    FirstRow = 6
    
    Min = Cells(4, 9).value
    Max = Cells(4, 10).value
                           
            If Not IsNumeric(Cells(2, 7)) Then
                MsgBox ("Input form incomplete. Query will be closed")
                Exit Sub
            End If
    
    Lat1Degrees = FixedPoint(0)    'Cells(2, 7)
    Lon1Degrees = FixedPoint(1)    'Cells(2, 8)
    
    earthSphereRadiusNauticalMiles = 3443.89849
            
        For i = 1 To C1 Step 1
                                       
                      
            Lat2Degrees = Coordinates(i, 1) 'Cells(n, 7)
            Lon2Degrees = Coordinates(i, 2) 'Cells(n, 8)
            
            'Convert each decimal degree to radians
            lat1Radians = (Lat1Degrees / 180) * 3.14159265359
            lon1Radians = (Lon1Degrees / 180) * 3.14159265359
            lat2Radians = (Lat2Degrees / 180) * 3.14159265359
            lon2Radians = (Lon2Degrees / 180) * 3.14159265359
            AsinBase = Sin(Sqr(Sin((lat1Radians - lat2Radians) / 2) ^ 2 + Cos(lat1Radians) _
            * Cos(lat2Radians) * Sin((lon1Radians - lon2Radians) / 2) ^ 2))
            DerivedAsin = (AsinBase / Sqr(-AsinBase * AsinBase + 1))
            'Get distance from [lat1,lon1] to [lat2,lon2]
             
            Distances(i - 1) = Round(2 * DerivedAsin * earthSphereRadiusNauticalMiles, 0)
                                        
        Next i
        
'final version requires calulated distance in col J

WS.Range("J6").Resize(UBound(Distances)).value = Application.Transpose(Distances)
 
'erase arrays
       
Erase Coordinates
Erase Distances
Erase FixedPoint
    
'delete rows outside specified distance range

Dim Z As Integer
    
    For Z = LastRow To 6 Step -1
    
        If Range("J" & Z) > Max Or Range("J" & Z) < Min Then
        Rows(Z).Delete
        End If
   Next
      
Application.DisplayAlerts = True

End Sub