CODEWITHSUNDEEP
excelexcel-2007vba
Bharu
Bharu

Reputation: 191

Merge the cell values if duplicates exist

I want to merge the values in column B if Duplicates exist in Column A

   A    B
  123   A
  123   B
  123   C
  456   D
  456   E
  789   F

My output should look like this

  A     B
 123    A B C
 456    D E
 789    F

I have a large amount of data and it is hard to do it manually ,So u guys have any idea to do it in macros in Excel?

Any help will be appreciated..Thanks in Advance

Upvotes: 1

Views: 4187

Answers (3)

rangan
rangan

Reputation: 26

In case you want the resultant data in the same cells the original data existed ie not in Cell 10, then you have to store the source data in a two dimensional array. Then from the array we have use the above code to insert the data in the same place the original data existed. Here goes the listing to accomplish the task:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim names(2 To 7, 2)
For i = 2 To 7
names(i, 1) = Cells(i, 1)
names(i, 2) = Cells(i, 2)
Next
On Error Resume Next:
Sheet1.Cells.Clear
 cnt = 2
    For i = 2 To 7
    strg = strg + names(i, 2)
    If names(i + 1, 1) <> names(i, 1) Then
    Cells(cnt, 1) = names(i, 1)
    Cells(cnt, 2) = strg
    cnt = cnt + 1
    strg = ""
    End If
    Next

End Sub

Please note that I have declared names array with two dimesnions to store the data. Then the array is searched to get the result.

Upvotes: 1

RowanC
RowanC

Reputation: 1649

I'd cheat, and use formulas as follows; 1) Sort by column A

2) In col C, add a formula to test if the current one is last (assuming there's a header, put this in C2

=if(A2<>A3,TRUE,FALSE)

Now, this should only be true for the last cell in a series of same ID's

3) in Col D, add a formula for concatenating if the ID's are the same, 

=if(A2=A1,D1&" "&B2,B2)

4) Filter on column C to show only the last cell in each series.

Cheers.

Upvotes: 3

rangan
rangan

Reputation: 11

You can use the following macro:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    cnt = 10
    For i = 2 To 7
    strg = strg + Cells(i, 2)
    If Cells(i + 1, 1) <> Cells(i, 1) Then
    Cells(cnt, 1) = Cells(i, 1)
    Cells(cnt, 2) = strg
    cnt = cnt + 1
    strg = ""
    End If
    Next

End Sub

The requested data will be printed from Cells 10

Upvotes: 1

Related Questions