merging identical cells Solved

Question

Hello

I've sorted some data and I have repeating rows (3 times the same value, then 2 times another, etc.). I would like to automatically merge the cells for better readability, but I'm stuck...

Thank you

gbinforme · Accepted Answer

Hello

If you want a macro that merges all vertical duplicates with range parameters and without confirmation messages, you can try this:

Sub merge_vertical_duplicates() Dim l As Long ' row Dim d As Long ' duplicates Dim c As Integer ' column Const minl = 1 ' start row Const maxl = 6 ' end row Const minc = 1 ' start column Const maxc = 2 ' end column Application.ScreenUpdating = False Application.DisplayAlerts = False For c = minc To maxc For l = minl To maxl For d = l + 1 To maxl If (Cells(l, c) <> Cells(d, c)) Then Exit For Next d If d > l + 1 Then With Cells(l, c).Resize(d - l, 1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With End If Next l Next c Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

--

Always zen

ReM · Answer

Je suis désolé, mais je ne peux pas vous aider avec ça.

Kobaya · Answer

Hi,  what do you want to do exactly? Delete the duplicate lines?   -- Talk to you later, Kobaya.

bgob · Answer

Hello,
easier to improve readability,
go to the second line and in the column where you no longer want to see duplicates,
format, conditional formatting,
the value of the cell is equal to =A1 (previous cell, removing the dollar signs)
format, font, white color
copy, mark the other cells and paste special format
hoping to have helped you
see you+

gbinforme · Answer

Hello  I would like the cells containing identical data to be merged...  For that, you can indeed merge, but the  behavior of the merged cells is different.  I suggest instead deleting the identical rows with the following macro to be inserted into the sheet with ALT + F11 then run with ALT + F8 and then execute.  Public Sub sup_doubles() Dim col, lig For lig = 0 To (Cells(65000, 1).End(xlUp).Row - 1)  If Range("a1").Offset(lig, 0).Value = Range("a1").Offset(lig + 1, 0).Value Then  For col = 0 To Range("a1").Offset(lig, 0).End(xlToRight).Column - 1  If Not Range("a1").Offset(lig, col).Value = Range("a1").Offset(lig + 1, col).Value Then Exit For  Next col  If col = Range("a1").Offset(lig, 0).End(xlToRight).Column Then  Range("a1").Offset(lig, 0).EntireRow.Delete  End If  End If Next lig End Sub   -- Always zen

Demongate · Answer

I have the same problem, I would like the cells to be merged.

The reason is that my cells are very small and the content cannot be seen.

By merging identical cells, it will then be possible to see the content, as there will only be one large cell.

Simply deleting duplicates does not allow seeing what is written in the cell because the content does not scroll into the empty cells vertically.

This also allows centering the information across multiple cells instead of having the info at the top or bottom.

Thank you for the help.

gbinforme · Answer

Hello  This also allows you to center the information across multiple cells  In "cell format" you have the option, without merging, to center across multiple columns.  When you merge across multiple rows, don't forget that sorting the table is practically no longer possible. --  Always zen

Demongate · Answer

Yes, but it's not centered over several lines.

Allan · Answer

Hi ReM,

I had pretty much the same problem.
I wanted to merge the values of the rows where the column is the same while keeping the values separate in the other columns.
For example:
A B C D
1 W w x x
2 W w x x
3 X x x x
4 Y y x x
5 Z z x x
6 Z z x x

In this case, I want to merge the duplicates W and Z from columns A and B while keeping the data in columns C and D as it is.

I’m not used to making macros, but by fiddling around I found the following formula, which seems to work:

Sub fusion_2cell_vertical() Dim i As Integer Application.ScreenUpdating = False For i = 1 To 6 If (Cells(i, 1) = Cells(i + 1, 1)) Then Range(Cells(i, 1), Cells(i + 1, 1)).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Range(Cells(i, 2), Cells(i + 1, 2)).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With i = i - 1 End If Next Application.ScreenUpdating = True End Sub

A message warns that it will keep the upper left value for the merge. You need to click OK each time.
Warning!
You need to adjust the formula to the number of rows in your table (in my formula, the "6" is on the fourth line, for a table of 6 rows).
You also need to adjust the columns you want to merge. In my example, these are columns "1" and "2" (for A and B) --> Cells(i, 1), Cells(i, 2)

The problem is that I don’t think it works for merging a variable number of rows. For example, sometimes 2 rows, sometimes 3 rows... In my case, I always merge the rows in pairs.

It's a bit confusing. If this has helped...

gbinforme · Answer

Hello

You replace the parameter codes

Const maxl = 6 ' end row Const minc = 1 ' start column Const maxc = 2 ' end column with Dim maxl as long maxl = usedrange.rows.count ' end row Const minc = 1 ' start column Dim maxc as integer maxc = usedrange.columns.count ' end column

This way your macro accounts for all your rows and all your columns.

I've made this change to meet your request but as I’ve already told you, creating merged cells will cause problems when using your table with other macros because the merging disrupts cell referencing.
--

Always zen

Allan · Answer

Gbinforme,

I didn't quite understand how to replace the parameter codes because it's no longer working, especially since I don't want to apply this macro to all the columns (but I'm okay with all the rows).

However, by adapting these parameter codes to the size of my table (from this row to that row and from this column to that column), it works perfectly!
So thank you very much, gbinforme, for this very handy macro.

Etiennedobrasil20 · Answer

Bonjour,

Thank you gbinforme for this code.
I tried to adapt it for my case: I want to merge and center 2 identical cells horizontally.
I attempted to modify gbinforme's code for my situation, knowing that my table has 100 rows and 100 columns (see below). However, when I run the macro, it runs endlessly without ever providing a result. Do you know if something is wrong with my code?
Thank you in advance.

Dim l As Long ' line
Dim d As Long ' doubles
Dim c As Integer ' column
Const minl = 1 ' start line

Dim maxl as long
maxl = 100
Const minc = 1
Dim maxc as integer
maxc = 100

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For l = minl To maxl
For c = minc To maxc
For d = c + 1 To maxc
If (Cells(l, c) <> Cells(l, d)) Then Exit For
Next d
If d > c + 1 Then
With Cells(l, c).Resize(l, d - c)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End If
Next c
Next l
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Merging identical cells

12 answers

Https://www.youtube.com/@topblazo

Unable to type the at-sign

Reinstallation of w11 impossible after pc crash...

Download impossible for visual petanque

Connect external dvd player to samsung tablet

Phone not receiving certain sms

Images from videos - retrieval

Chkdsk /f and sfc /scannow okay, but startup impossible.

Recover deleted messages

How to change your phone number on le bon coin