Subscript out of range error

A

aadebayo

Registered User.
Local time
Today, 03:47
Joined
May 10, 2004
Messages
43
I am currently have the subscrpt out of range error when I run the code below. The error occurs when the code in red is run. I could not seem to find a similar problem here. Please can anybody help me.

Ade

Do While Not rst.EOF
For I = 1 To CountList
If CodeList(I) = rst("COST-CENTRE") And I <> 1 Then 'match found
match = True
Exit For
Else: match = False
End If
Next I
CountList = CountList + 1
CodeList(CountList) = rst("COST-CENTRE")
Call glrstatus("Processing Cost Centre " & rst("COST-CENTRE"), "Please Wait")
If IsNull(rst("CLIENT_SCHOOL_MEALS-CC")) Or match = True Then
rst.MoveNext
Else
client_school_cc = rst("CLIENT_SCHOOL_MEALS-CC")
'''''''get number of price bandings for journal lines'''''''''''''
Set dbs = CurrentProject.Connection
Set rstOrders = New ADODB.Recordset
rstOrders.Open ("tbmealprice"), dbs, adOpenDynamic, adLockOptimistic
' Set rstOrders = dbs.OpenRecordset("tbmealprice")
rstOrders.MoveLast
rstOrders.MoveFirst
Do While Not rstOrders.EOF
mealtype = rstOrders("MEAL-TYPE-CODE")
meal_price = rstOrders("MEAL-SERVICE-PRICE")
DINING_CENTRE_NAME = rst("DINING-CENTRE-NAME")
Select_Query = "SELECT MEAL-SERVICE-PRICE, MEAL-TYPE-CODE, WEEK-ENDING-DATE, WEEK-ACTUAL-NO, MEAL-TYPE-NAME, CLIENT_SCHOOL_MEALS-CC FROM qrymealsales WHERE MEAL-TYPE-CODE = '" & mealtype & "' AND MEAL-SERVICE-PRICE = " & meal_price & " AND CLIENT_SCHOOL_MEALS-CC = '" & client_school_cc & "' AND MEAL-TYPE-NAME Like '*PUPIL FREE*' AND week-ending-date= #" & Format(Get_Date, "mm/dd/yyyy") & "# GROUP BY MEAL-SERVICE-PRICE, WEEK-ACTUAL-NO,WEEK-ENDING-DATE, MEAL-TYPE-NAME, CLIENT_SCHOOL_MEALS-CC, MEAL-TYPE-CODE"
' Select_Query = "SELECT * FROM qrymealsales WHERE MEAL-TYPE-CODE = '" & mealtype & "' AND MEAL-SERVICE-PRICE = " & meal_price & " AND CLIENT_SCHOOL_MEALS-CC = '" & client_school_cc & "' AND MEAL-TYPE-NAME Like '*PUPIL FREE*' AND week-ending-date= # " & Format(Get_Date, "mm/dd/yyyy") & " #"
Debug.Print Select_Query
' qDef.parameters = [mealtype]
Set dbs = CurrentProject.Connection
Set rstQuery = New ADODB.Recordset
rstQuery.Open ("qrymealsales"), dbs, adOpenDynamic, adLockOptimistic
' Set rstQuery = dbs.OpenRecordset("qrymealsales")
' Set rstQuery = dbs.OpenRecordset(Select_Query)
If rstQuery.EOF = True And rstQuery.BOF = True Then
'no records have been selected
Else
no_free_meals = 0
rstQuery.MoveLast
rstQuery.MoveFirst
Do While Not rstQuery.EOF
no_free_meals = no_free_meals + rstQuery("WEEK-ACTUAL-NO")
rstQuery.MoveNext
Loop
If no_free_meals = 0 Then 'if no sales, skip to next
'do nowt
Else 'journal CREDIT line details
rstQuery.MoveFirst
batch_no = 0
journal_no = "J1C"
line_number = line_no
ref_number = "w/e " & Format(Journal_Date, "ddmmyy") 'week ending date to which data refers
ledger_code = client_school_cc & "/6965"
debit_amount = 0 'leave blank- this is a credit journal
credit_amount = Format(no_free_meals * meal_price, "####0.00")
analysis = no_free_meals & " meals" 'actual no. of free pupil school meals per price banding
user_data = 0
narrative = "£" & Format(meal_price, "####0.000") & " price " & LCase(DINING_CENTRE_NAME) 'price of meal & school name
original_account = mealtype
debit_units = " "
unit_of_measure = " "
journal_line
line_no = line_no + 1
End If
End If
rstOrders.MoveNext
Loop
rst.MoveNext
End If
Loop
 
Which size has CodeList or where do you "redim" it?

BTW could please Tag your code?

filo65
 
Last edited:
Sorry I missed the first couple of lines


Code: 
'''loop through for each dining centre in table
' problem is, don't want to write two lines where the cost code are the same, so need to keep
' a track of what cost codes have been processed, and check each new one against list
TableSize = 1
Dim CodeList() As String
ReDim CodeList(TableSize + 1)
Do While Not rst.EOF
    For I = 1 To CountList
        If CodeList(I) = rst("COST-CENTRE") And I <> 1 Then 'match found
            match = True
            Exit For
        Else: match = False
        End If
    Next I
    CountList = CountList + 1
   [COLOR=Red] CodeList(CountList) = rst("COST-CENTRE")[/COLOR]
    Call glrstatus("Processing Cost Centre " & rst("COST-CENTRE"), "Please Wait")
    If IsNull(rst("CLIENT_SCHOOL_MEALS-CC")) Or match = True Then
        rst.MoveNext
    Else
        client_school_cc = rst("CLIENT_SCHOOL_MEALS-CC")
        '''''''get number of price bandings for journal lines'''''''''''''
        Set dbs = CurrentProject.Connection
        Set rstOrders = New ADODB.Recordset
        rstOrders.Open ("tbmealprice"), dbs, adOpenDynamic, adLockOptimistic
'        Set rstOrders = dbs.OpenRecordset("tbmealprice")
        rstOrders.MoveLast
        rstOrders.MoveFirst
        Do While Not rstOrders.EOF
            mealtype = rstOrders("MEAL-TYPE-CODE")
            meal_price = rstOrders("MEAL-SERVICE-PRICE")
            DINING_CENTRE_NAME = rst("DINING-CENTRE-NAME")
            Select_Query = "SELECT MEAL-SERVICE-PRICE, MEAL-TYPE-CODE, WEEK-ENDING-DATE, WEEK-ACTUAL-NO, MEAL-TYPE-NAME, CLIENT_SCHOOL_MEALS-CC FROM qrymealsales WHERE MEAL-TYPE-CODE = '" & mealtype & "' AND MEAL-SERVICE-PRICE = " & meal_price & " AND CLIENT_SCHOOL_MEALS-CC = '" & client_school_cc & "' AND MEAL-TYPE-NAME Like '*PUPIL FREE*' AND week-ending-date= #" & Format(Get_Date, "mm/dd/yyyy") & "# GROUP BY MEAL-SERVICE-PRICE, WEEK-ACTUAL-NO,WEEK-ENDING-DATE, MEAL-TYPE-NAME, CLIENT_SCHOOL_MEALS-CC, MEAL-TYPE-CODE"
           ' Select_Query = "SELECT * FROM qrymealsales WHERE MEAL-TYPE-CODE = '" & mealtype & "' AND MEAL-SERVICE-PRICE = " & meal_price & " AND CLIENT_SCHOOL_MEALS-CC = '" & client_school_cc & "' AND MEAL-TYPE-NAME Like '*PUPIL FREE*' AND week-ending-date= # " & Format(Get_Date, "mm/dd/yyyy") & " #"
            Debug.Print Select_Query
          '  qDef.parameters = [mealtype]
            Set dbs = CurrentProject.Connection
            Set rstQuery = New ADODB.Recordset
            rstQuery.Open ("qrymealsales"), dbs, adOpenDynamic, adLockOptimistic
        '    Set rstQuery = dbs.OpenRecordset("qrymealsales")
         '   Set rstQuery = dbs.OpenRecordset(Select_Query)
            If rstQuery.EOF = True And rstQuery.BOF = True Then
                'no records have been selected
            Else
                no_free_meals = 0
                rstQuery.MoveLast
                rstQuery.MoveFirst
                Do While Not rstQuery.EOF
                    no_free_meals = no_free_meals + rstQuery("WEEK-ACTUAL-NO")
                    rstQuery.MoveNext
                Loop
                If no_free_meals = 0 Then   'if no sales, skip to next
                    'do nowt
                Else    'journal CREDIT line details
                    rstQuery.MoveFirst
                    batch_no = 0
                    journal_no = "J1C"
                    line_number = line_no
                    ref_number = "w/e " & Format(Journal_Date, "ddmmyy") 'week ending date to which data refers
                    ledger_code = client_school_cc & "/6965"
                    debit_amount = 0        'leave blank- this is a credit journal
                    credit_amount = Format(no_free_meals * meal_price, "####0.00")
                    analysis = no_free_meals & " meals"  'actual no. of free pupil school meals per price banding
                    user_data = 0
                    narrative = "£" & Format(meal_price, "####0.000") & " price " & LCase(DINING_CENTRE_NAME) 'price of meal & school name
                    original_account = mealtype
                    debit_units = " "
                    unit_of_measure = " "
                    journal_line
                    line_no = line_no + 1
                End If
            End If
            rstOrders.MoveNext
        Loop
        rst.MoveNext
    End If
Loop
 
What is rst("Cost-Centre")? I've never seen a recordset used in this fashion. If Cost-Centre is a field in rst, try rst![Cost-Centre]

I also don't see where you initiated CountList to any value - you are relying on your increment statement to initiate it to 1.

Code: 
For I = 1 To CountList
        If CodeList(I) = rst("COST-CENTRE") And I <> 1 Then 'match found
            match = True
            Exit For
        Else: match = False
        End If
    Next I
You realize that this code isn't run on your first iteration (since CountList wasn't initialized)?
 
Thanks Tom, it worked. I am new to VBA, I used to program in a completely different language.
 
You must log in or register to reply here.

Similar threads

I
Runtime error 9, Subscript out of Range
Replies
1
Views
2,582
MarkK
MarkK
A
Too few Parameter
Replies
1
Views
778
Mile-O
Mile-O
A
No value given for one or more parameters
Replies
2
Views
2,724
aadebayo
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom