CODEWITHSUNDEEP
excelvba
nr.iras.sk
nr.iras.sk

Reputation: 8488

Looping through Merged cells in VBA

Is it possible to loop through merged cells in .

Upvotes: 9

Views: 15444

Answers (4)

Milky
Milky

Reputation: 99

Here's an iterative sub given a range with merged cells

Sub IterateMerged(ByVal r As Range)

    ' You can switch these loops to iterate through rows first 
    Dim CurrentRow as Double
    Dim CurrentCol as Double
    For CurrentRow = 0 To r.Rows.Count Step 0
        For CurrentCol = 0 to r.Columns.Count Step 0

            ' You could additionally add a if statement to check if this cell is merged, to iterate only over merged cells
            ' Your code goes here
            MsgBox "I'm at: " & r.Cells(CurrentRow, CurrentCol).MergeArea.Address

            CurrentCol = CurrentCol + r.Cells(CurrentRow, CurrentCol).MergeArea.Columns.Count
        Next CurrentCol
        CurrentRow = CurrentRow + r.Cells(CurrentRow, CurrentCol).MergeArea.Rows.Count
    Next CurrentRow

End Sub

Upvotes: 0

brettdj
brettdj

Reputation: 55672

The above answers look to have you sorted.

If you don't know where the merged cells are then you can use the following routine to quickly detect them.

When I built Mappit! I realised that when I developed merged cell reporting that merged cells were part of xlBlanks

So you can use the code to detect merged cells immediately rather than loop through each cell testing for the MergedCells property being true.

Sub DetectMerged()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = Intersect(Cells.SpecialCells(xlFormulas), Cells.SpecialCells(xlBlanks))
Set rng2 = Intersect(Cells.SpecialCells(xlConstants), Cells.SpecialCells(xlBlanks))
On Error GoTo 0
If Not rng1 Is Nothing Then MsgBox "Merged formulae cells in " & rng1.Address(0, 0)
If Not rng2 Is Nothing Then MsgBox "Merged constant cells in " & rng2.Address(0, 0)
End Sub

Upvotes: 10

Jerry Beaucaire
Jerry Beaucaire

Reputation: 3187

Just a little tighter, similar idea:

Option Explicit

Sub ListValues()
Dim i As Long

    For i = 4 To 40 Step 6
        Debug.Print Range("B" & i).Value
    Next i

End Sub

Upvotes: 2

JMax
JMax

Reputation: 26591

Here is a first stab to your issue:

Option Explicit

Sub loopOverCells()
    Dim rCell As Range
    Dim i As Integer

    Set rCell = [B1]
    For i = 1 To 6
        Debug.Print rCell.Address
        Set rCell = rCell.Offset(1, 0)    ' Jump 1 row down to the next cell
    Next i
End Sub

Upvotes: 5

Related Questions