Subscript out of range error

[CaptainKen]

I made a small change to simply skip/remove F4, F20:F24, F94:F101 from the original working rangeBudget as shown below.

Original rangeBudget array on Line 43 no error, works.
Modified rangeBudget array on Line 39 gives error.

Range F81:F:90 on the Months sheet is the last highlighted range when I step through the code and within the rangeMonths H81:S90 and H94:S101 are never copied. Then I get error "subscript out of range". When you review the two ranges, the range that works actually contains the modified range that skips specific ranges. In testing, if I remove H81:S90 and H94:S101 from line 39 rangeMonths I get no error. I'm lost on how simply omitting some cells from an existing range contained in the original array can cause the error?

I have a main xlsm workbook with vba in ThisWorkbook object to copy specific ranges of cells from another xlsx workbook. The only difference between the two workbooks is that the target with the vba has the xlsm extension and the source has the xlsx extension. I just doubled checked that they were the same by saving the target xlsm workbook as the xlxs. After doing this, I entered some test dollar amounts in the source workbook. So this confirms the ranges exists in both.

NOTE: Be sure to change sourceFilePath to your file location before testing.

Target.xlsm

Source.xlsx

Sub CopyDataFromClosedWorkbook()
    Dim sourceFilePath As String
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim destinationWorksheet As Worksheet
    Dim rangeMonths As Variant
    Dim rangeBudget As Variant
    Dim i As Integer
    Dim sourceRangeMonths As Range
    Dim sourceRangeBudget As Range
    Dim destinationRangeMonths As Range
    Dim destinationRangeBudget As Range

    ' Set the file path of the workbook to copy data from
    sourceFilePath = "D:\OneDrive\Documents\Budget Stuff\Monthly Budget BEFORE Retirement - NEW.xlsx"

    ' Set the destination worksheet in the current workbook
    Set destinationWorksheet = ThisWorkbook.Sheets("Months") ' Change "Months" to your destination sheet name

    ' Define the same source and destination ranges to use for BOTH workbooks
    rangeMonths = Array("H4:S8", "H10:S16", "H20:S24", "H26:S37", "H39:S46", "H48:S54", _
                        "H56:S60", "H62:S72", "H74:S79", "H81:S90", "H94:S101")

    ' This range SKIPS F4, F20:F24, F94:F101, however it generates "subscript out of range" error
    rangeBudget = Array("F5:F8", "F10:F16", "F26:F37", "F39:F46", "F48:F54", _
                        "F56:F60", "F62:F72", "F74:F79", "F81:F90")

    ' This is the working range with no errors
    'rangeBudget = Array("F4:F8", "F10:F16", "F20:F24", "F26:F37", "F39:F46", "F48:F54", _
                            "F56:F60", "F62:F72", "F74:F79", "F81:F90", "F94:F101")

    ' Open the source workbook without displaying it
    Set sourceWorkbook = Workbooks.Open(sourceFilePath, ReadOnly:=True)

    ' Loop through each range and copy data from the source to the destination
    For i = LBound(rangeMonths) To UBound(rangeMonths)
        ' Set the source worksheet in the source workbook
        Set sourceWorksheet = sourceWorkbook.Sheets("Months") ' Change "Months" to your source sheet name
        
        ' Set the source ranges in the source workbook
        Set sourceRangeMonths = sourceWorksheet.Range(rangeMonths(i))
        Set sourceRangeBudget = sourceWorksheet.Range(rangeBudget(i))

        ' Set the destination ranges in the current workbook
        Set destinationRangeMonths = destinationWorksheet.Range(rangeMonths(i))
        Set destinationRangeBudget = destinationWorksheet.Range(rangeBudget(i))

        ' Suppress the alert message
        Application.DisplayAlerts = False

        ' Copy the data from the source ranges to the destination ranges
        sourceRangeMonths.Copy destinationRangeMonths
        sourceRangeBudget.Copy destinationRangeBudget
        
        ' Restore alert settings
        Application.DisplayAlerts = True
    Next i

    ' Close the source workbook without saving changes
    sourceWorkbook.Close SaveChanges:=False

    ' Optionally, you can activate the destination worksheet
    destinationWorksheet.Activate

    ' Optionally, you can display a message indicating the copy is complete
    MsgBox "Data copied successfully from the closed workbook."

End Sub

 

[Domenic]

That's because rangeMonths has been assigned an array containing11 elements, whereas rangeBudget has been assigned an array containing 9 elements. So, as you loop through each element in rangeMonths and reach the element with index 9, you'll get that error when trying to referencing the element in rangeBudget with index 9, since it only contains 9 elements. Remember indexing starts at zero.

Hope this helps!

 

[CaptainKen]

Thank you, that was the problem!

Hoping you can assist with another issue.

After separating the ranges into different loops, and making sure the code worked, I then added code to make sure that there weren't any cells in the ranges that contain formulas that reference cells on other sheets in the target workbook and if true then abort and close the source workbook..

When I use Stop on each code line in the loops, "Run-time error 424 object required" occurs when I attempt to move past each of these points.
sourceRangeMonths.Copy destinationRangeMonths.Value
sourceRangeBudget.Copy destinationRangeBudget.Value

Sub CopyDataFromClosedWorkbook()
    Dim sourceFilePath As String
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim destinationWorksheet As Worksheet
    Dim rangeMonths As Variant
    Dim rangeBudget As Variant
    Dim i As Integer
    Dim sourceRangeMonths As Range
    Dim sourceRangeBudget As Range
    Dim destinationRangeMonths As Range
    Dim destinationRangeBudget As Range

    ' Set the file path of the workbook to copy data from
    sourceFilePath = "D:\OneDrive\FTP-FileShare\Monthly Budget BEFORE Retirement - NEW.xlsx"

    ' Set the destination worksheet in the current workbook
    Set destinationWorksheet = ThisWorkbook.Sheets("Months") ' Change "Months" to your destination sheet name

    ' Define the same source and destination ranges to use for BOTH workbooks
    rangeMonths = Array("H4:S8", "H10:S16", "H20:S24", "H26:S37", "H39:S46", "H48:S54", _
                        "H56:S60", "H62:S72", "H74:S79", "H81:S90", "H94:S101")

    ' This range SKIPS (See above reason details) F4, F20:F24, F81, and F94:F101
    rangeBudget = Array("F5:F8", "F10:F16", "F26:F37", "F39:F46", "F48:F54", _
                        "F56:F60", "F62:F72", "F74:F79", "F81:F90")

    ' Open the source workbook without displaying it
    Set sourceWorkbook = Workbooks.Open(sourceFilePath, ReadOnly:=True)

Dim formulaCheck As Boolean  ' Define formulaCheck as a Boolean variable

    ' Loop through the rangeMonths and copy data from the source to the destination
    For i = LBound(rangeMonths) To UBound(rangeMonths)
        ' Set the source worksheet in the source workbook
        Set sourceWorksheet = sourceWorkbook.Sheets("Months") ' Change "Months" to your source sheet name

        ' Set the source ranges in the source workbook
        Set sourceRangeMonths = sourceWorksheet.Range(rangeMonths(i))

        ' Set the destination ranges in the current workbook
        Set destinationRangeMonths = destinationWorksheet.Range(rangeMonths(i))

        ' Check if the source range contains named cell references from another sheet
        formulaCheck = CheckForNamedCellReferences(sourceRangeMonths, sourceWorkbook)

        ' If named cell references are found, display a custom message and abort
        If formulaCheck Then
            MsgBox "The source range '" & sourceRangeMonths.Address & "' contains references to named cells from another sheet. Operation aborted."
            Exit Sub
        End If

        ' Suppress the alert message
        Application.DisplayAlerts = False

        ' Copy the data from the source ranges to the destination ranges
        sourceRangeMonths.Copy destinationRangeMonths.Value

        ' Restore alert settings
        Application.DisplayAlerts = True
    Next i
    
    ' Loop through the rangeBudget and copy data from the source to the destination
    For i = LBound(rangeBudget) To UBound(rangeBudget)
        ' Set the source worksheet in the source workbook
        Set sourceWorksheet = sourceWorkbook.Sheets("Months") ' Change "Months" to your source sheet name
        
        ' Set the source ranges in the source workbook
        Set sourceRangeBudget = sourceWorksheet.Range(rangeBudget(i))

        ' Set the destination ranges in the current workbook
        Set destinationRangeBudget = destinationWorksheet.Range(rangeBudget(i))

        ' Check if the source range contains named cell references from another sheet
        formulaCheck = CheckForNamedCellReferences(sourceRangeBudget, sourceWorkbook)

        ' If named cell references are found, display a custom message and abort
        If formulaCheck Then
            MsgBox "The source range '" & sourceRangeBudget.Address & "' contains references to named cells from another sheet. Operation aborted."
            Exit Sub
        End If

        ' Suppress the alert message
        Application.DisplayAlerts = False

        ' Copy the data from the source ranges to the destination ranges
        sourceRangeBudget.Copy destinationRangeBudget.Value
        
        ' Restore alert settings
        Application.DisplayAlerts = True
    Next i

    ' Close the source workbook without saving changes
    sourceWorkbook.Close SaveChanges:=False

    ' Activate the destination worksheet
    destinationWorksheet.Activate

    ' Display a message indicating the copy is complete
    MsgBox "Data copied successfully from the closed workbook."

End Sub

Function CheckForNamedCellReferences(rng As Range, sourceWorkbook As Workbook) As Boolean
    Dim formula As String
    Dim namedCellPattern As String
    Dim cell As Range

    CheckForNamedCellReferences = False

    ' Check each cell in the range for formulas containing named cell references
    For Each cell In rng
        If cell.HasFormula Then
            formula = cell.formula
            ' Check for formulas referencing cells from another sheet using 'SheetName!' pattern
            If InStr(1, formula, "!") > 0 Then
                ' Named cell reference found, set the flag and exit the loop
                CheckForNamedCellReferences = True
                Exit For
            End If
        End If
    Next cell

    ' Close the source workbook if it's open
    If Not sourceWorkbook Is Nothing Then
        sourceWorkbook.Close SaveChanges:=False
    End If

 

[Domenic]

The Copy method of the Range object accepts a Range object, so you'll need to replace...

sourceRangeBudget.Copy destinationRangeBudget.Value

with

sourceRangeBudget.Copy destinationRangeBudget

Hope this helps!

 

[CaptainKen]

Thank you again for responding. I still get the same error at the same places.

 

[Domenic]

I'm assuming that you've made the corrections in both places, correct?

If so, can you please confirm exactly which lines are giving you an error, and the error messages that are being displayed?

 

[CaptainKen]

When I use Stop on each code line in the loops, "Run-time error 424 object required" occurs when I attempt to move past each of these points.
sourceRangeMonths.Copy destinationRangeMonths
sourceRangeBudget.Copy destinationRangeBudget

NOTE: Be sure to change sourceFilePath to your file location before testing.

Target.xlsm

Source.xlsx

 

[Domenic]

That's because you're closing your source workbook in CheckForNamedCellReferences. Just remove those lines from that procedure. Then you already have code in your main procedure which closes the source workbook.

Hope this helps!

 

[CaptainKen]

Yes I'm closing it as part of the check if a formula exists in one of the cells in the range. If true, the loops abort and then source workbook needs to close. Is there better code to handle this?

 

[Domenic]

Oh, I see. Okay, first amend CheckForNamedCellReferences as follows...

Function CheckForNamedCellReferences(rng As Range) As Boolean

    Dim formula As String
    Dim namedCellPattern As String
    Dim cell As Range

    CheckForNamedCellReferences = False

    ' Check each cell in the range for formulas containing named cell references
    For Each cell In rng
        If cell.HasFormula Then
            formula = cell.formula
            ' Check for formulas referencing cells from another sheet using 'SheetName!' pattern
            If InStr(1, formula, "!") > 0 Then
                ' Named cell reference found, set the flag and exit the loop
                CheckForNamedCellReferences = True
                Exit For
            End If
        End If
    Next cell
 
End Function

Then, replace...

        ' Check if the source range contains named cell references from another sheet
        formulaCheck = CheckForNamedCellReferences(sourceRangeBudget, sourceWorkbook)

with

        ' Check if the source range contains named cell references from another sheet
        formulaCheck = CheckForNamedCellReferences(sourceRangeBudget)

Then replace...

        ' If named cell references are found, display a custom message and abort
        If formulaCheck Then
            MsgBox "The source range '" & sourceRangeBudget.Address & "' contains references to named cells from another sheet. Operation aborted."
            Exit Sub
        End If

with

        ' If named cell references are found, display a custom message and abort
        If formulaCheck Then
            MsgBox "The source range '" & sourceRangeBudget.Address & "' contains references to named cells from another sheet. Operation aborted."
            sourceWorkbook.Close SaveChanges:=False
            Exit Sub
        End If

And the same thing for your other ones.

Hope this helps!