GiftedMilk
GiftedMilk

Reputation: 11

A VBA Array reference is out of range, despite it being the size I set it to?

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

Answers (2)

VBasic2008
VBasic2008

Reputation: 55073

Ranges and Arrays

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

Tim Williams
Tim Williams

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

Related Questions