cwassmuth
05-07-2018, 12:22 PM
I have a set of code that creates an array and populates it with the distance between a set of two coordinates, however using this function it gives a run-time error, invalid procedure or argument. I am wondering if there may be a limit that is being reached by the function as it is trying to populate a 500x500 array. How can I get around this while still being able to run my same code.
Option Explicit
Sub test()
Dim sheetSource As Worksheet
Dim sheetResults As Worksheet
Dim intPos As Long22191
Dim intMax As Long
Dim i As Long
Dim j As Long
Dim strID As String
Dim dblDistance As Double
Dim dblTemp As Double
Dim Lat1 As Double
Dim Lat2 As Double
Dim Long1 As Double
Dim Long2 As Double
Const PI As Double = 3.14159265358979
Set sheetSource = ThisWorkbook.Sheets("Sheet1")
Set sheetResults = ThisWorkbook.Sheets("Sheet2")
intPos = 1
' 1 Build the matrix
For i = 2 To sheetSource.Rows.Count
strID = Trim(sheetSource.Cells(i, 1))
If strID = "" Then Exit For
intPos = intPos + 1
sheetResults.Cells(intPos, 1) = strID
sheetResults.Cells(1, intPos) = strID
Next i
intMax = intPos
If intMax = 1 Then Exit Sub ' no data
' 2 : compute matrix
For i = 2 To intMax 'looping on lines
Lat1 = sheetSource.Cells(i, 2)
Long1 = sheetSource.Cells(i, 3)
For j = 2 To intMax 'looping on columns
Lat2 = sheetSource.Cells(j, 2)
Long2 = sheetSource.Cells(j, 3)
' Some hard trigonometry over here
dblTemp = (Sin((Lat2 * PI) / 180)) * (Sin((Lat1 * PI) / 180)) + (Cos((Lat2 * PI) / 180)) * _
((Cos((Lat1 * PI) / 180))) * (Cos((Long1 - Long2) * (PI / 180)))
If dblTemp = 1 Then ' If 1, the 2 points are the same. Avoid a division by zero
sheetResults.Cells(i, j) = 0
Else
dblDistance = 6371 * (Atn(-dblTemp / Sqr(-dblTemp * dblTemp + 1)) + 2 * Atn(1))
sheetResults.Cells(i, j) = dblDistance
End If
Next j
Next i
End Sub
When debugged the debugger points to the line ' dblDistance = 6371 * (Atn(-dblTemp / Sqr(-dblTemp * dblTemp + 1)) + 2 * Atn(1))' as the issue
I have attached the file as well
Thank you in advance
Option Explicit
Sub test()
Dim sheetSource As Worksheet
Dim sheetResults As Worksheet
Dim intPos As Long22191
Dim intMax As Long
Dim i As Long
Dim j As Long
Dim strID As String
Dim dblDistance As Double
Dim dblTemp As Double
Dim Lat1 As Double
Dim Lat2 As Double
Dim Long1 As Double
Dim Long2 As Double
Const PI As Double = 3.14159265358979
Set sheetSource = ThisWorkbook.Sheets("Sheet1")
Set sheetResults = ThisWorkbook.Sheets("Sheet2")
intPos = 1
' 1 Build the matrix
For i = 2 To sheetSource.Rows.Count
strID = Trim(sheetSource.Cells(i, 1))
If strID = "" Then Exit For
intPos = intPos + 1
sheetResults.Cells(intPos, 1) = strID
sheetResults.Cells(1, intPos) = strID
Next i
intMax = intPos
If intMax = 1 Then Exit Sub ' no data
' 2 : compute matrix
For i = 2 To intMax 'looping on lines
Lat1 = sheetSource.Cells(i, 2)
Long1 = sheetSource.Cells(i, 3)
For j = 2 To intMax 'looping on columns
Lat2 = sheetSource.Cells(j, 2)
Long2 = sheetSource.Cells(j, 3)
' Some hard trigonometry over here
dblTemp = (Sin((Lat2 * PI) / 180)) * (Sin((Lat1 * PI) / 180)) + (Cos((Lat2 * PI) / 180)) * _
((Cos((Lat1 * PI) / 180))) * (Cos((Long1 - Long2) * (PI / 180)))
If dblTemp = 1 Then ' If 1, the 2 points are the same. Avoid a division by zero
sheetResults.Cells(i, j) = 0
Else
dblDistance = 6371 * (Atn(-dblTemp / Sqr(-dblTemp * dblTemp + 1)) + 2 * Atn(1))
sheetResults.Cells(i, j) = dblDistance
End If
Next j
Next i
End Sub
When debugged the debugger points to the line ' dblDistance = 6371 * (Atn(-dblTemp / Sqr(-dblTemp * dblTemp + 1)) + 2 * Atn(1))' as the issue
I have attached the file as well
Thank you in advance