Search code examples
excelvbaruntime-error

Comparing Active Cell Address To Contents of Array


I am trying to loop through the values in a given range and write to an array the address of any cell that matches some criteria (for demo purposes, I am just looking for cells whose value is "somevalue"). I then want to take a second loop through the same range and compare the address of the active cell to the list of addresses written to the array. If there is a match then I want to merge the active cell with the 2 cells below it. That's it. Simplified code is below.

The code works fine and is recording the correct addresses to the array. But at the top of the second loop at this line "If cSched.Address = aBands(x, 1) Then", I am getting the following error: Run-time error '9': Subscript out of range. All suggestions appreciated!

Sub stackoverflowtest2()

Dim shtSched As Worksheet 'the tab where schedule blocks will be created
Dim rSched As Range 'range of schedule
Dim cSched As Range 'a single cell on Schedule tab
Dim aBands As Variant 'array containing addresses of band locations on schedule
Dim BandCounter As Integer 'counter for number of bands written
Dim x As Integer 'counter
Dim msg As String 'for testing

'Setup
    Set shtSched = ActiveWorkbook.ActiveSheet
    Set rSched = Range(shtSched.Range("Start"), shtSched.Range("Start").Offset(122, 6))

'Loop 1: work through cells, record address for matches
    BandCounter = 1
    For Each cSched In rSched
        If cSched.Value = "somevalue" Then
            ReDim aBands(1 To BandCounter, 1)
            aBands(BandCounter, 1) = cSched.Address
            msg = msg & aBands(BandCounter, 1) & vbNewLine 'for testing
            BandCounter = BandCounter + 1
        End If
    Next

'Show all matching addresses, for testing
    MsgBox msg

'Loop 2: work through cells 2nd time, if address is in array then merge cells
    For Each cSched In rSched
        For x = 1 To BandCounter
            If cSched.Address = aBands(x, 1) Then
                MsgBox "We have a match!" 'for testing
                Range(cSched, cSched.Offset(2, 0)).MergeCells = True
                Exit For
            End If
        Next x
    Next
    
End Sub

Solution

  • This can be accomplished using nested For loops to avoid iterating cells twice.

    Sub demo()
        Dim rCol, i, rSched As Range
        Set rSched = Range("B10:H20")
        For Each rCol In rSched.Columns
            For i = 1 To rCol.Cells.Count
                If rCol.Cells(i).Value = "somevalue" Then
                    rCol.Cells(i).Resize(3, 1).MergeCells = True
                    i = i + 2
                End If
            Next
        Next
    End Sub