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
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