Reputation: 11
I am a beginner with VBA, and am running into trouble with arrays. Details below-
Excel VBA:
Code:
Sub Calculatetest()
Dim i As Integer
Dim Dist As Double
Dim MaxD As Integer
Dim PLat As Double
Dim PLon As Double
Dim c As Integer
Dim ID() As Variant
Dim Lat() As Variant
Dim Lon() As Variant
Dim LastRow As Long
MaxD = Cells(13, 2).Value
MinP = Cells(14, 2).Value
PLat = Cells(5, 2).Value
PLon = Cells(6, 2).Value
LastRow = Cells(16, 2).Value - 1
ReDim ID(1 To LastRow)
ID() = Worksheets("LOCDB").Range("V2:V" & LastRow).Value
Lat() = Sheets("LOCDB").Range("I2:I" & LastRow).Value
Lon() = Worksheets("LOCDB").Range("J2:J" & LastRow).Value
c = 1
For i = 1 To LastRow
Dist = Haversine(PLat, PLon, Lat(i), Lon(i))
'**ERROR POPS ON THIS LINE^**
If Dist < MaxD Then
Cells(c, 10).Value = ID(i)
c = c + 1
End If
Next i
End Sub
Error Given: Runtime Error '9' Subscript out of Range
Value of "LastRow" = 1528
Haversine() Function returns a Double, and is functional when used in the sheet.
Column V on Sheet LOCDB is verified to contain only the Header in the first row, incrementing integers, and blank spaces below.
Purpose of Code: With a database of US Cities and their longitude/latitude locations, the code grabs the Latitude/Longitude of the specified city, which is pulled to the active sheet with standard excel formulas.
The "LastRow" variable is also calculated with excel formulas. It searches the database for the last line which has at least a minimum population specified by the user, as the database is sorted by population. The goal is to make an array to the size of "LastRow", and run the haversine formula to calculate it's distance. IF the distance is under a user specified value, it writes the ID number of the database item to the next line of the active worksheet.
I have tried running MsgBox on the LBound and UBound of ID(), and the numbers seem to match. I have even tried making ID() Bigger than it needs to be, with no success. What am I doing wrong?
Upvotes: 1
Views: 79
Reputation: 55073
Sub Calculatetest()
' Define constants.
Const SRC_SHEET As String = "LOCDB"
Const SRC_FIRST_ROW As Long = 2
Const DST_FIRST_ROW As Long = 1 ' are you sure, no header?
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Read from the destination worksheet.
Dim dws As Worksheet: Set dws = wb.ActiveSheet ' improve!
' You might be writing to the wrong worksheet!
' Prevent overwriting data on the source worksheet!
If StrComp(dws.Name, SRC_SHEET, vbTextCompare) = 0 Then
MsgBox "Cannot write to worksheet """ & SRC_SHEET & """.", vbCritical
Exit Sub
End If
Dim PLat As Double: PLat = dws.Range("B5").Value
Dim PLon As Double: PLon = dws.Range("B6").Value
Dim MaxD As Double: MaxD = dws.Range("B13").Value
'Dim MinP As Double: MinP = ws.Range("B14").Value ' not used!?
' !!! Cell 'B16' contains the last source row
' so the number of rows is 'last row - first row + 1'!!!
Dim srCount As Long: srCount = dws.Range("B16").Value - SRC_FIRST_ROW + 1
' Read from the source worksheet.
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim IDs(): IDs = sws.Cells(SRC_FIRST_ROW, "V").Resize(srCount).Value
Dim Lats(): Lats = sws.Cells(SRC_FIRST_ROW, "I").Resize(srCount).Value
Dim Longs(): Longs = sws.Cells(SRC_FIRST_ROW, "J").Resize(srCount).Value
' Calculate and modify data.
Dim sr As Long, dr As Long, Dist As Double
For sr = 1 To srCount
' !!! They are 2D one-based single-column arrays,
' the reason behind 'Runtime error '9': Subscript out of Range'!!!
Dist = Haversine(PLat, PLon, Lats(sr, 1), Longs(sr, 1))
If Dist < MaxD Then
dr = dr + 1
IDs(dr, 1) = IDs(sr, 1)
'Lats(dr, 1) = Lats(sr, 1)
'Longs(dr, 1) = Longs(sr, 1)
End If
Next sr
If dr = 0 Then
MsgBox "All distances too long.", vbCritical
Exit Sub
End If
' Write the result to the destination worksheet.
With dws.Cells(DST_FIRST_ROW, "J")
.Resize(dr).Value = IDs
.Resize(dws.Rows.Count - .Row - dr + 1).Offset(dr).Clear
End With
' With dws.Cells(DST_FIRST_ROW, "K")
' .Resize(dr).Value = Lats
' .Resize(dws.Rows.Count - .Row - dr + 1).Offset(dr).Clear
' End With
' With dws.Cells(DST_FIRST_ROW, "L")
' .Resize(dr).Value = Longs
' .Resize(dws.Rows.Count - .Row - dr + 1).Offset(dr).Clear
' End With
' Inform.
MsgBox "Ids retrieved.", vbInformation
End Sub
Upvotes: 0
Reputation: 166970
If LastRow
is (eg) 10, then
Worksheets("LOCDB").Range("V2:V" & LastRow).Value
is a 2D array with bounds (1 to 9, 1 to 1) - because the range doesn't start at Row1.
So you can't loop from 1 to LastRow
and use that as an index into ID
, because the upper bound of ID's first dimension is one less than LastRow
It's safer to do something like
For i = 1 To UBound(ID, 1)
Upvotes: 2