jbehmoaras
New Member
- Joined
- Apr 8, 2011
- Messages
- 8
Below is some code i am using to fill an array with some data. Unfortunately i have been stuck on a subscript out of range error i cant seem to find the source of.
Public Type STRArr
occ As Variant
adr As Variant
revpar As Variant
year As Integer
End Type
Public strFY() As STRArr
Public strYTD() As STRArr
Public strTTM() As STRArr
Public Sub createArr()
Dim strFY(10) As STRArr
Dim strYTD(10) As STRArr
Dim strTTM(10) As STRArr
End Sub
Public Sub STR_CustTrend_Import()
'Application.ScreenUpdating = false
Dim row As Integer
Dim col As Integer
Dim i As Integer
Dim n As Integer
Dim arrInc As Integer
i = 0
row = 0
col = 0
arrInc = 0
Dim wb As Workbook
Set wb = ThisWorkbook
For Each wb In Workbooks
i = i + 1
Next
'this section makes sure only 2 files are open, STR and model
If i > 2 Then
MsgBox "You can only have two sheets open, the STR file and the model."
Exit Sub
End If
If i < 2 Then
MsgBox "You must open the STR file and the model."
Exit Sub
End If
' ------ ------ ------
'initialize array
createArr
'trigger
Dim trig As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
wb.Sheets("2) By Measure").Activate
Range("b7").Select
i = 0
Do Until Selection.Offset(i, 0).Value = "Supply"
'loop to get to a data set
Do Until Selection.Offset(i, 0).Value <> "" And _
Selection.Offset(i, 0).Value <> "Avg" And _
Selection.Offset(i, 0).Value <> "ADR ($)" And _
Selection.Offset(i, 0).Value <> "RevPAR ($)"
If Selection.Offset(i, 0).Value = "ADR ($)" Then trig = "ADR"
If Selection.Offset(i, 0).Value = "RevPAR ($)" Then trig = "RevPAR"
If Selection.Offset(i, 0).Value = "Supply" Then trig = "Supply"
i = i + 1
Loop
arrInc = 1
If Selection.Offset(i, 0).Value <> "Supply" Then
If trig = "" Then
strYTD(1).year = 2000 'HERE IS WHERE I GET THE ERROR
[...]
End If
If trig = "ADR" Then
[...]
End If
If trig = "RevPAR" Then
[...]
End If
i = i + 1
arrInc = arrInc + 1
End If
Loop
End If
Next
End Sub
Public Type STRArr
occ As Variant
adr As Variant
revpar As Variant
year As Integer
End Type
Public strFY() As STRArr
Public strYTD() As STRArr
Public strTTM() As STRArr
Public Sub createArr()
Dim strFY(10) As STRArr
Dim strYTD(10) As STRArr
Dim strTTM(10) As STRArr
End Sub
Public Sub STR_CustTrend_Import()
'Application.ScreenUpdating = false
Dim row As Integer
Dim col As Integer
Dim i As Integer
Dim n As Integer
Dim arrInc As Integer
i = 0
row = 0
col = 0
arrInc = 0
Dim wb As Workbook
Set wb = ThisWorkbook
For Each wb In Workbooks
i = i + 1
Next
'this section makes sure only 2 files are open, STR and model
If i > 2 Then
MsgBox "You can only have two sheets open, the STR file and the model."
Exit Sub
End If
If i < 2 Then
MsgBox "You must open the STR file and the model."
Exit Sub
End If
' ------ ------ ------
'initialize array
createArr
'trigger
Dim trig As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
wb.Sheets("2) By Measure").Activate
Range("b7").Select
i = 0
Do Until Selection.Offset(i, 0).Value = "Supply"
'loop to get to a data set
Do Until Selection.Offset(i, 0).Value <> "" And _
Selection.Offset(i, 0).Value <> "Avg" And _
Selection.Offset(i, 0).Value <> "ADR ($)" And _
Selection.Offset(i, 0).Value <> "RevPAR ($)"
If Selection.Offset(i, 0).Value = "ADR ($)" Then trig = "ADR"
If Selection.Offset(i, 0).Value = "RevPAR ($)" Then trig = "RevPAR"
If Selection.Offset(i, 0).Value = "Supply" Then trig = "Supply"
i = i + 1
Loop
arrInc = 1
If Selection.Offset(i, 0).Value <> "Supply" Then
If trig = "" Then
strYTD(1).year = 2000 'HERE IS WHERE I GET THE ERROR
[...]
End If
If trig = "ADR" Then
[...]
End If
If trig = "RevPAR" Then
[...]
End If
i = i + 1
arrInc = arrInc + 1
End If
Loop
End If
Next
End Sub