Excel: Merge adjacent rows if they contain the same values [Closed]

Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
- - Latest reply: lukal4
Posts
1
Registration date
Wednesday December 17, 2014
Status
Member
Last seen
December 17, 2014
- Dec 17, 2014 at 05:06 PM
Hello all,

I am trying to speed up a task which I have do it manually with VBA:

There is a table like below"

Date;Name;ID;Text
20120101;Peter;00001;ABTC
20120102;May;00002;DdfEF
20120102;Jane;00002;GHIRTE
20120204;Larry;00003;qweR
20120506;Larry;00004;klnfdg
20120506;Tom;00004;ewrwrk
20120506;Ray;00004;sdfff
20120506;Ron;00005;kkkk


What I need to do is to merge adaject rows whenever they contain the same ID, resulting:

Date;Name;ID;Text
20120101;Peter;00001;ABTC
20120102;May;00002;DdfEF
20120102;Jane;*MERGED*;GHIRTE
20120204;Larry;00003;qweR
20120506;Larry;00004;klnfdg
20120506;Tom;*MERGED*;ewrwrk
20120506;Ray;*MERGED*;sdfff
20120506;Ron;00005;kkkk

Can anyone help me to figure out how should I write the macro? Thanks a lot.
See more 

5 replies

Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
753
0
Thank you
Try this

Option Explicit

Public Sub mergeInformation()
    Dim targetSheet         As String
    Dim totalRows           As Long
    Dim currentRow          As Long
    Dim startRow            As Long
    Dim lastProcessedId     As String
    Dim targetColumn        As String
    
    targetSheet = "Sheet1"
    targetColumn = "C"
    startRow = 2
    
    With Sheets(targetSheet)
        totalRows = getItemLocation("*", .Cells)
        lastProcessedId = "Nothing Processed"
        
        For currentRow = startRow To totalRows
            If (.Cells(currentRow, targetColumn) <> lastProcessedId) Then
               lastProcessedId = .Cells(currentRow, targetColumn)
            Else
                .Cells(currentRow, targetColumn) = """MERGED"""
            End If
        Next currentRow
    End With
End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
Sorry, there is a misunderstanding. I want the cells with the same ID to be actually merged instead of showing the text "merged". Is there a way to do so? Thanks a lot.
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
753 -
like how ? you need to give example. the code follow your sample example. it is case of GIGO
kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
You can download the sample file here (please remove the space):

w w w.2shared.c o m/document/ik2GvQZK/Demo.html

I have added a complication which looks more like the actual worksheet I am working on.

Thanks for your help.
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
753 -
then try this
Option Explicit

Public Sub mergeInformation()
    Dim targetSheet         As String
    Dim totalRows           As Long
    Dim currentRow          As Long
    Dim currentColumn       As Integer
    Dim startRow            As Long
    Dim lastProcessedId     As Variant
    Dim targetColumn        As Variant
    
    targetSheet = "Sheet1"
    targetColumn = Array("A", "B", "C")
    startRow = 2
    
    With Sheets(targetSheet)
        totalRows = getItemLocation("*", .Cells)
        lastProcessedId = Array("Nothing Processed", "Nothing Processed", "Nothing Processed")
        
        For currentRow = startRow To totalRows
            For currentColumn = LBound(targetColumn) To UBound(targetColumn)
                If (.Cells(currentRow, targetColumn(currentColumn)) <> lastProcessedId(currentColumn)) Then
                   lastProcessedId(currentColumn) = .Cells(currentRow, targetColumn(currentColumn))
                Else
                    .Cells(currentRow, targetColumn(currentColumn)) = vbNullString
                    .Range(.Cells(currentRow - 1, targetColumn(currentColumn)), .Cells(currentRow, targetColumn(currentColumn))).MergeCells = True
                    
                End If
            Next
        Next currentRow
    End With
End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
Posts
2403
Registration date
Sunday September 23, 2012
Status
Moderator
Last seen
December 13, 2018
504
0
Thank you
Hi kobe1121,

There is a similar solution that will help. I hope this will give you an idea as to how to write the desired macro:

1. Open a new Excel Sheet.
2. Enter the following values:
A1 - Date
B1 - Name
C1 - ID
D1 - Text
3. Fill the columns with the desired data.
4. Click File in the top menu of the Excel, Select Options and then Customize ribbon, from the right pane check Developer and then click OK.
5. Click Home and go to the original excel sheet.
6. Click Developer from the top Menu.
7. Click Insert and then select command button from the ActiveX Controls.
8. Draw a button in a convenient location on the Excel Sheet.
9. Click Design Mode and then double click the button, it will open the Macro Editing window.
10. Paste the below code in the window:

Dim d As Date, r As Long, n As Integer, c As Range

For r = 1 To Cells(Rows.Count, 3).End(xlUp).Row - 1
If Int(Cells(r, 3)) = Int(Cells(r + 1, 3)) Then
n = n + 1
End If
If Int(Cells(r, 3)) <> Int(Cells(r + 1, 3)) And n > 0 Then
For Each c In Range(Cells(r - n + 1, 3), Cells(r, 3))
c.Font.ColorIndex = 2
c.Interior.ColorIndex = 2
Next c
Range(Cells(r - n, 3), Cells(r, 3)).BorderAround ColorIndex:=3, Weight:=xlThin
n = 0
End If
Next r

11. Close the Macro Editing window go back to the excel sheet.
12. Again click design mode.
13. Now click on the button you created it will format the data in the 3rd column.

Steps 4 through 6 are valid for Excel 2010, for earlier versions of Excel these steps might differ.

Do reply if you need any further help or clarifications.

Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
0
Thank you
http://www.2shared.com/document/ik2GvQZK/Demo.html

You can download the sample file here. I have also added a complication which looks more like the actual spreadsheet I am working on. Thanks for your help.
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
0
Thank you
Thanks rizvisa1 again for your reply, but I have copied those to vba to run, and nothing happened...
kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
Sorry I got it after testing a few more times. Thanks a lot!! :)
kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
Just one more problem.

With the latest macro, the rows with the same dates/names will be merged. I only want them to be matched if those rows contain the same ID. How should I modify the macro to get the result?

Thanks for your patience!
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
753 -
Clarify one thing
Look at your example. In that for row 3 and row 4, the id match. But names dont match. but dates match. So as per your example should only id column merge or both id and date column should merge
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
0
Thank you
I have a further complication on this. Help would be greatly appreciated.
When I am using the macro, I have found some problems.
Please download the exhibit here (remove the space)
w w w. 2shared . c o m/file/Hf5RKvLy/Demo.html

I want the macro to merge cells according to one core column ("ID" in the exhibit)
1. Adjacent columns with the same "ID" will be merged
2. When "ID" are the same, the macro will try to merge other columns also: "NAME", "DATE", "CURRENCY"
3. Adjacent columns with same values but not having the same "ID" would not be merged: "CURRENCY" will not be merged if "ID" are not the same

Many many thanks!
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
753 -
it merges if id matches. I am in a rush so might be missing your point.Could you reexplain in full detail and please try to see all possibilities and complexities that you may have in one go
kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
With the current macro, rows containing the same value in columns other than ID will also be merged. (If the dates are the same, they will be merged regardless of whether the ID on those rows are the same)

The result I want is that I can set which column to be the "core" column to determine if the rows should be merged (in the example, ID). For example, when the rows contain the same ID, the macro will merge the ID column, and then check if the other columns("Date" and "Currency" in the latest sample file) contain the same values - if so, those rows will also be merged; if the rows contain different values on the "core" column, even if the other columns contain the same values, they would not be merged.

I think the latest file contains all the possibilities. Thanks, your help and patience are greatly appreciated. ;-)
lukal4
Posts
1
Registration date
Wednesday December 17, 2014
Status
Member
Last seen
December 17, 2014
> kobe1121
Posts
11
Registration date
Wednesday October 10, 2012
Status
Member
Last seen
October 29, 2012
-
Hi Kobe,
I have the same problem: merge cells according to one core column ("ID" in the exhibit)
Do you solved your problem?
If yes, Can you post the codes Vba to help me please?

Anybody can help me?
Hi Kobe,
I can't access the site you shared the latest file. Can you please paste the codes here? I really need this. Thank you!