Help With Function to Merge Cells Automatically

[bjw122]

If I have a worksheet that looks like this simplified version:

Column A
-----------
Value 1
Value 1
Value 1
Value 1
VALUE 2
VALUE 2
VALUE 2
Test
Test
Test
Test

And I want to be able to use a macro to merge cells that have the same value in column A to produce output like this:

Column A
-----------
Value 1
[Merged Cell]
[Merged Cell]
[Merged Cell]
VALUE 2
[Merged Cell]
[Merged Cell]
Test
[Merged Cell]
[Merged Cell]
[Merged Cell]

* Note that column A has rows 2 through 4 merged (as in 'Format Cells' --> 'Merge Cells') with row 1. Likewise, rows 5 through 7 are merged as well as rows 8 through 11.

The psedudocode to do this would look something like the following but I need help making this into working code:

Sub Merge_RowsX()
TgtStr As String, Dim i As Long, BeginRowNum As Integer,
EndRowNum As Integer (and additional variables as needed)

Application.ScreenUpdating = False

For i = 1 To [A65536].End(xlUp).Row

1.] Get the value of first cell in column A
* Store TgtStr
* Store BeginRowNum
2.] Iterate through subsequent rows in column A until value is different from TgtStr
* Store EndRowNum
3.] Merge cells BeginRowNum to EndRowNum

Next i Repeat loop (i.e. get new TgtStr)

Application.ScreenUpdating = True
End Sub

Any help is greatly appreciated, I hope my explanation is clear.

 

[Greg Truby]

bjw,

I hate to interrupt Erik and Dan when they're having this much fun, but I don't see where anyone has asked you why you are merging these cells? Merging cells tends to make a mell of a hess out of things as a general rule. More often than not, I've found that some simple conditional formatting will accomplish what the poster wants done while keeping the data in a format that is much more managable.

Kind regards,

 

[erik.van.geit]

Greg,
right, in 2 other threads I made the same comment today..;
(could write an "undo-code" for this when needed )
but in this case I can see some advantages (layout and navigation), perhaps these can be solved another way

this is a colored-solution

For i = 1 To j - 1 Step 2
HL = IIf(HL = 35, 36, 35)
Range(Cells(ArrRowNumbers(i), col), Cells(ArrRowNumbers(i + 1), col)).Interior.ColorIndex = HL
Next i

on top put
Dim HL as Integer 'highlight

how do you do it using conditional format ?
best regards,
Erik

 

[HalfAce]

By all means, Greg's comments are hard to argue.

Just for fun, these are the times I got from running both the "fillit" and (the latest) "merge_same_data" routines.

fillit runs at a steady 2.765625 seconds.

merge_same_data runs at (an averaged) 4.802083333 seconds
on a machine with a P4 processor, a gig of ram, several other applications open, and constant calculations from updating about a dozen PLC outputs on another machine its networked with.

(Not too shabby in my opinion.)

[EDIT:]
To do this with Cond. Formatting, you could highlight column A, and use Cell Value Is > Equal to > =A2
and format the font color to white (or whatever).

(Is that what you had in mind Greg?)

Dan

 

[Greg Truby]

Hi Erik,

You and I saw a similar situation a few months ago here. I also worked a Spanish thread with the same question about that time. In the English thread the OP wanted to delete cells with repeated data rather than merge cells as our OP wants to do here. Whether merging or deleting - wiping out data makes a mess of tables. It inhibits sorting and pivot tables among other problems. Whenever someone sends me a worksheet with merged cells, I usually end up splitting them (and wanting to whack them in the head for merging them in the first place). As we showed in those other threads, you can use simple CF and white font on white pattern to make the layout look like merged cells without wrecking the table's layout. That's why I was asking bjw why he wanted to merge cells. He may have a perfectly good reason, but I just didn't see where we'd asked the question and pointed out the drawbacks to merging cells.

Regards,

 

[erik.van.geit]

Thanks, Greg,
when asking for conditional format, I was thinking of getting a colored result
to the right the result from the other thread you mentioned

Map1.xls
	A	B	C	D	E	F
1	CF ?		CF ?		CF other thread
2	abc		abc		abc	D2 = D1
3	abc		abc
4	abc		abc
5	rte		rte		rte
6	rte		rte
7	t		t		t
8	h		h		h
9	p		p		p
10	u		u		u
11	u		u
Blad2

perhaps it's difficult ?
best regards,
Erik

 

[bjw122]

Hey HalfAce -

Like I said at the beginning of this thread, I'm new to VBA. I was taking another look at this function today that you posted:

Sub MergeColA() 
Dim c As Range, A As Range 
Dim RwsToMrg As Long 
With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

Set A = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) 

For Each c In A 
    RwsToMrg = Application.WorksheetFunction.CountIf(A, c) 
    If RwsToMrg > 1 Then 
      With c.Resize(RwsToMrg, 1) 
        .Merge 
        .VerticalAlignment = xlCenter 
      End With 
    End If 
Next c 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 
End Sub

I'm trying to learn so I'm thinking what if I wanted to change this to work with column 'E' instead of column 'A'. I though if I changed the line:
Set A = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
to
Set A = Range(Cells(5, 1), Cells(Rows.Count, 1).End(xlUp))
that it would work, as 5 is the 5th column.

But this didn't work, what gives?

Thanks for helping out, I'm just trying to learn.

 

[Greg Truby]

I don't know if Dan's logged in yet, so I'll respond...

Set A = Range(Cells(1, 5), Cells(Rows.Count, 5).End(xlUp))

But have a look here at Nimrod's suggestion on using FIND instead of END. If there's a chance your columns may not all be filled, this would be a better solution.

 

[bjw122]

Set A = Range(Cells(1, 5), Cells(Rows.Count, 5).End(xlUp))

I don't know why but for some reason that didn't work. The function returned very quickly and didn't merge any of the rows in column E. If you have any ideas let me know. . .

 

[Greg Truby]

That would be because you'd need to edit the line of code that's doing the merging. Change

With c.Resize(RwsToMrg, 1)

to read

With c.Resize(RwsToMrg, 5)

BTW, you never did answer my question as to why you are merging cells in the first place. Did you follow the links I cite above in post #13? Merging cells makes a heck of a mess of things more often than not.

 

[Zack Barresse]

Stay in one topic please: http://www.mrexcel.com/board2/viewtopic.php?p=873501