Home > Software design >  VBA Subscript out of range when trying to loop through array to read values
VBA Subscript out of range when trying to loop through array to read values

Time:05-20

I am wracking my brain try to figure out what I'm doing wrong with the code below. I have a string of predefined worksheets, that I need to run specific code for and I'm getting a compile error. The code is setup to copy data from one sheet to another. How do I get it to do the same thing for multiple sheets?

When I step through the code sht is showing the MHP60,MHP61,MHP62 and not just MHP60.

I keep getting a subscript out of range error.

Sub Prepare_CYTD_Report()
    Dim addresses() As String
    Dim addresses2() As String
    Dim SheetNames() As String
    Dim SheetNames2() As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim my_Filename
    
    'Declare variables for MHP60, MHP61, MHP62 Trial Balance Values
    Dim i, lastcol As Long
    Dim tabNames, cell As Range
    Dim tabName As String
    Dim sht As Variant
  
   
    addresses = Strings.Split("A9,A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",") 'Trial Balance string values
    addresses2 = Strings.Split("G9,G12:G26,G32:G38,G42:G58,G62:G70,G73:G76,G83:G90", ",")  'Prior Month string values
    SheetNames = Strings.Split("MHP60,MHP61,MHP62")
    'SheetNames2 = Strings.Split("MHP60-CYTDprior,MHP61-CYTDprior,MHP62-CYTDprior")
    
    Set wb1 = ActiveWorkbook    'Revenue & Expenditure Summary Workbook
    
    '*****************************Open CYTD files
    my_Filename = Application.GetOpenFilename(fileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select File to create CYTD Reports")

    If my_Filename = False Then
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(my_Filename)
    
    '*****************************Load Column Header Strings & Copy Data
    For Each sht In SheetNames
        lastcol = wb1.Sheets(sht).Cells(5, Columns.Count).End(xlToLeft).Column
    
        On Error Resume Next
        Set tabNames = wb1.Sheets(sht).Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
        'actual non-formula text values on row 4 from column C up to column lastCol'
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox "No headers were found on row 4 of MHP60", vbCritical
            Exit Sub
        End If
    
        For Each cell In tabNames
        tabName = Strings.Trim(cell.Value2)
        'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
            If CStr(wb1.Sheets(sht).Evaluate("ISREF('[" & wb2.Name & "]" & tabName & "'!$A$1)")) = "True" Then
            'If wb2 has a tab named for the value in tabName
                For i = 0 To UBound(addresses)
                    wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets(sht).Range(addresses(i)).Offset(0, cell.Column - 1).Value2
                    'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
                Next i
            Else
                Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
            End If
        Next cell
    Next sht
      
    MsgBox "CYTD Report Creation Complete", vbOKOnly
        
    Application.ScreenUpdating = True
End Sub

CodePudding user response:

Split by what?

SheetNames = Strings.Split("MHP60,MHP61,MHP62")

Split by comma? Then use the following instead:

SheetNames = Strings.Split("MHP60,MHP61,MHP62", ",")

Alternative

Dim SheetNames() As Variant  ' needs to be Variant to work with Array()
SheetNames = Array("MHP60", "MHP61", "MHP62")

This should be quicker as your macro does not need to split the string and has it as array directly.

  • Related