Thread: Subscript out of range error

Hi there,

really hoping someone can help, I've been staring at this for days and cant see where I've gone wrong.
None of this is my code, it's been dumped on me by the previous employee.

I've been tasked with updating it (simple you would think) - Unfortunately I am not allowed to make any significant changes to the way it works.

I've had to add two new sheets to an excel workbook "CAB Weekly Dashboard - Commissioner Dev.xls" which I have done.
This proceedure updates the tables in the database, then it should initialise the array of worksheets that have queries to refresh, then loop through them, refreshing the queries in the background.

Does this fine, but it will not recognise the new sheets in the xls file.
I've tried everything I can think of, but still getting the same result.

Here's the code:

CODE
Option Compare Database
Option Explicit
Option Base 1
Const strDir = "S:\Finance and Investment\DST\Choice & CAB\Downloads\"
Const strDB = "S:\Finance and Investment\DST\Choice & CAB\Databases\Choose and Book.mdb"
Const strDir2 = "S:\Finance and Investment\DST\Choice & CAB\Reports\Weekly\"


Sub CaB()

Dim strTabs(4) As String, strDashWeekTabsC(5) As String, strDashWeekTabsP(2) As String, strDashMnthTabsC(2) As String, strDashMnthTabsP(5) As String, varTables As Variant, strNames(4) As String, varFile As Variant, intFilterCell(4) As Integer

Dim i As Integer, j As Integer, k As Integer, lastrow As Integer, intRHUTAL, intRHUMnth As Integer, strYearFin As String, strMonth As String, strYear As String, strMonth2 As String, strFile As String
Dim dteDate As Date, strDate1 As String, strDate2 As String, strDate3 As String, strDate4 As String, strDate5 As String, strDate6 As String, strDate7 As String, strWkMth As String
Dim appAccess As Access.Application, appExcel As Excel.Application, strDate8 As String, strDate9 As String, strPath As String
Dim intLine As Integer, intCol As Integer
Dim strPrd As String

On Error GoTo ErrorHandler

strWkMth = Forms!mainform!cboCaBWkMth.Value

'Assign values to variables used in Monthly procedure
If strWkMth = "Monthly" Then
    strMonth = Forms!mainform!cboCaBMth.Value
    strYear = "20" & Right(strMonth, 2)
    strMonth2 = MonthName(Month(strMonth))
    If Month(strMonth) < 10 Then
        strDate5 = Right(strMonth, 2) & "0" & Month(strMonth)
    Else
        strDate5 = Right(strMonth, 2) & Month(strMonth)
    End If
    strDate8 = Right(strDate5, 2) & "/01/" & Left(strDate5, 2)
End If
    
strYearFin = Forms!mainform!cboYr.Value
intRHUTAL = Forms!mainform!cboCaBRHUTAL.Value
intRHUMnth = Forms!mainform!cboCaBRHUMnth
dteDate = Forms!mainform!cboCaBWk.Value
strDate1 = dteDate - 7
strDate7 = Right(strDate1, 2) & Mid(strDate1, 4, 2) & Left(strDate1, 2)
strDate2 = Right(dteDate, 2) & Mid(dteDate, 4, 2) & Left(dteDate, 2)
'strDate3 = MonthName(Mid(dteDate, 4, 2))
strDate4 = Right(dteDate, 4)
strDate6 = Mid(dteDate, 4, 2) & "/" & Left(dteDate, 2) & "/" & Right(dteDate, 2)
strDate9 = Mid(strDate1, 4, 2) & "/" & Left(strDate1, 2) & "/" & Right(strDate1, 2)
strPath = strDir2 & strYearFin & "\PDFs\"

' Initialise monthly variables
varFile = Array(" EBSX05", " EBSX03")
varTables = Array("tblSHA", "tblPCT", "tblGPPRACTICE", "tblPROVIDER")

' Initialise arrays of names for weekly spreadsheets
' Names of worksheets in Weekly Report
strTabs(1) = "1 - SHA"
strTabs(2) = "2 - PCT"
strTabs(3) = "3 - GP PRACTICE"
strTabs(4) = "4 - PROVIDER"

' Which column should be filtered to exclude non South Central data
intFilterCell(1) = 0
intFilterCell(2) = 4
intFilterCell(3) = 6
intFilterCell(4) = 4

' Names of csv upload files
strNames(1) = "SHA"
strNames(2) = "PCT"
strNames(3) = "GPPRTC"
strNames(4) = "PROV"

' Names of worksheets in Dashboards which have queries in them which have to be refreshed
strDashWeekTabsC(1) = "Weekly data"
strDashWeekTabsC(2) = "WeeklyBySHA"
strDashWeekTabsC(3) = "WeeklyPractice"
strDashWeekTabsC(4) = "WeekSHAMthAG"
strDashWeekTabsC(5) = "WeekDataMthAG"
strDashMnthTabsC(1) = "Monthly CAB data"
strDashMnthTabsC(2) = "Monthly GP refs"
strDashWeekTabsP(1) = "Weekly data"
strDashWeekTabsP(2) = "Weekly slot issues"
strDashMnthTabsP(1) = "Monthly CAB data"
strDashMnthTabsP(2) = "Monthly GP refs"
strDashMnthTabsP(3) = "Monthly Slot Issues"
strDashMnthTabsP(4) = "Rejections"
strDashMnthTabsP(5) = "Redirections"





'======== Refresh queries in dashboards according to whether Weekly or Monthly was selected ========
With appExcel
    DoCmd.Echo False, "Updating Dashboards."
    .Application.ScreenUpdating = False
    .Application.DisplayAlerts = False

   'Process  new Commissioner Dashboard
    .Workbooks.Open FileName:=strDir2 & "CAB Weekly Dashboard - Commissioner Dev.xls", UpdateLinks:=xlUpdateLinksNever
    .Calculation = xlManual

    If strWkMth = "Weekly" Then
        'Refresh Weekly queries
        '''''          TTTTT EEEEE SSSSS TTTTT IIIII N   N GGGGG          '''''
        '''''            T   E     S       T     I   NN  N G              '''''
        '''''            T   EEE   SSSSS   T     I   N N N G  GG          '''''
        '''''            T   E         S   T     I   N  NN G   G          '''''
        '''''            T   EEEEE SSSSS   T   IIIII N   N GGGGG          '''''
        
        
        i = 1
        Do While i <= UBound(strDashWeekTabsC)
        
********************************************************************************
**********************
          .ActiveWorkbook.Worksheets(strDashWeekTabsC(i)).QueryTables(1).BackgroundQuery = False
                                  .ActiveWorkbook.Worksheets(i).QueryTables(1).Refresh
********************************************************************************
***********************
SECTION ABOVE CAUSING THE ERROR.
********************************************************************************
***********************        
            i = i + 1
        Loop
        

            
            
        
        
        
        '''''          TTTTT EEEEE SSSSS TTTTT IIIII N   N GGGGG          '''''
        '''''            T   E     S       T     I   NN  N G              '''''
        '''''            T   EEE   SSSSS   T     I   N N N G  GG          '''''
        '''''            T   E         S   T     I   N  NN G   G          '''''
        '''''            T   EEEEE SSSSS   T   IIIII N   N GGGGG          '''''
      
        
        
        
        'Update date in Data Sumnmary sheet to current week
        .ActiveWorkbook.Worksheets("Data Summary").Visible = xlSheetVisible
        .ActiveWorkbook.Worksheets("Data Summary").Range("ReportDate") = dteDate
        .ActiveWorkbook.Worksheets("Data Summary").Visible = xlSheetHidden
        'Update date in GP Practice analysis to current week - this will invoke the macro to update the list in this sheet
        .ActiveWorkbook.Worksheets("GP Practice analysis").Range("GPDate") = dteDate

    Else
        'Refresh Monthly queries
        i = 1
        Do While i <= UBound(strDashMnthTabsC)
            .ActiveWorkbook.Worksheets(strDashMnthTabsC(i)).QueryTables(1).BackgroundQuery = False
            .ActiveWorkbook.Worksheets(strDashMnthTabsC(i)).QueryTables(1).Refresh
            i = i + 1
        Loop
        'Update date in Data Summary sheet to current month
        .ActiveWorkbook.Worksheets("Data Summary").Visible = xlSheetVisible
        .ActiveWorkbook.Worksheets("Data Summary").Range("ReportMonth").Value = strDate8
        .ActiveWorkbook.Worksheets("Data Summary").Visible = xlSheetHidden
    End If
   ' re-set calculation to automatic
    .Calculation = xlCalculationAutomatic
    ' Select cell on front sheet so that correct stuff is PDFed and so that spreadsheet opens on this sheet
    .ActiveWorkbook.Worksheets(1).Activate
    .ActiveWorkbook.Worksheets(1).Range("A1").Select
    .ActiveWorkbook.Save

    MsgBox "Database and Dashboards have been successfully updated."

ExitSub: ' Turn everything back on
    Set appAccess = Nothing
    If Not appExcel Is Nothing Then appExcel.Quit
    Set appExcel = Nothing
    DoCmd.SetWarnings True
    DoCmd.Echo True
    Exit Sub
    
ErrorHandler:
    MsgBox "The most recent error number is " & Err & ". Its message text is: " & Error(Err)
    GoTo ExitSub

End Sub

Sorry for the length of code, but thought I'd give you the full picture.

I've tried to highlight the part that's giving me errors, it's contained in a line of ******s and at the top of the TESTING section.

Any help gratefully received!

Kind regards,
Ben

I can't check this but strDashWeekTabsC is a String but you are using it in a loop, i is an integer and I would expect strDashWeekTabsC to be an integer

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save