Loop to merge cells does not work on last few rows

[abschy]

Hi all!

Im having some issues with my code below. It works fine on majority of rows, but towards the end, it's having some issues.

What my code does is this:

- if values of cells (i,j) and cells (i+r,j), basically 1 cell and the cell below it are the same, then they merge and other columns merge with the same rows
- i looped this withe the "r" loop to compare eg cells A1 and A2, and if they merge, then A1 and A3, as i may have multiple lines of the same data

however, towards the last few rows, the cells end up merging more than it should..

for example, if I have different data in A4 and A5, with A5 being the last data, the code will merge A4 AND A5, all the way till A10 or so even though A4 and A5 are different, and A6-A10 have no data.

Any help would be great to solve this merging issue!!

Thank you!!!

[TABLE="width: 1092"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Dim i As Long    Dim j As Long
    Dim r As Long


    For i = 1 To Range("B" & rows.count).End(xlUp).Row
        For j = 2 To 2
         For r = 1 To 5
            If Cells(i, j).Value = Cells(i + r, j).Value Then
            Range(Cells(i, j), Cells(i + r, j)).Merge
            Range(Cells(i, j - 1), Cells(i + r, j - 1)).Merge
            Range(Cells(i, j + 7), Cells(i + r, j + 7)).Merge
            Range(Cells(i, j + 8), Cells(i + r, j + 8)).Merge
            Range(Cells(i, j + 9), Cells(i + r, j + 9)).Merge
            End If
         Next r
        Next j
    Next i
    Columns("A:J").HorizontalAlignment = xlLeft
    Columns("A:J").VerticalAlignment = xlCenter

 

[StephenCrump]

- i looped this withe the "r" loop to compare eg cells A1 and A2, and if they merge, then A1 and A3, as i may have multiple lines of the same data

.... if I have different data in A4 and A5, with A5 being the last data, the code will merge A4 AND A5, all the way till A10 or so even though A4 and A5 are different, and A6-A10 have no data.

.. but your code is looping based on the number of values in column B, not column A:

For i = 1 To Range("[COLOR=#ff0000][B]B[/B][/COLOR]" & Rows.Count).End(xlUp).Row

.. and merging column A based on the values in Column B:

For j = [COLOR=#ff0000][B]2[/B] [/COLOR]To [COLOR=#ff0000][B]2[/B][/COLOR]
 For r = 1 To 5
    If Cells(i, [COLOR=#ff0000][B]j[/B][/COLOR]).Value = Cells(i + r, [COLOR=#ff0000][B]j[/B][/COLOR]).Value Then  'test column B
        Range(Cells(i, j), Cells(i + r, j)).Merge 'Merge column B
        Range(Cells(i, j - 1), Cells(i + r, j - 1)).Merge 'Merge column A

 

[abschy]

Hi there!

I was just using an example haha

My code loops for column B, then merges cells in column A,B, and a few others.

Currently my only issue is for the last few rows, which i think may have to do with the "r" loop but im not very sure why its only causing problems for certain last few rows only:/

I run this code for several batches of data, and sometimes it works perfectly fine, and sometimes it merges the whole bottom 5+ rows together past the actual data set!

Thanks!

 

[StephenCrump]

Currently my only issue is for the last few rows, which i think may have to do with the "r" loop but im not very sure why its only causing problems for certain last few rows only

If your data ends in, say B10, and your code merges B9 and B10, then B10 and B11 will now match (both blank), as will B12, B13 etc, and your code will merge them all.

You don't need the r loop, nor the j loop.

And most people on this forum will also say you don't need merged cells, as they cause all sorts of problems. You'd be better off using Centre Across Selection instead.

 

[abschy]

I totally get that merged cells cause so many so many problems..however, i need them just for presentation purposes..

in my code, if i remove the r and j loop, the cells dont merge past 2 rows.. eg B9 and B10 merge, but if B11 has the same value as B9 and B10, it does not merge with them..

Thanks so much for your help!!

 

[StephenCrump]

You'd be better off using Centre Across Selection instead.

Duh! Sorry, posting before thinking. Obviously that won't work across rows.

 

[StephenCrump]

Application.DisplayAlerts = False

For i = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Cells(i, 2).Value = Cells(i - 1, 2).Value Then
        Range(Cells(i, 2), Cells(i - 1, 2)).Merge
        'etc for other columns
    End If
Next i

Application.DisplayAlerts = True

 

[abschy]

Haha! Thank you so much! this worked really well!