VBA to Delete Duplicate Rows and Concatenate a String

Hello,
I am trying to develop a macro that will concatenate strings and separate them with commas in one cell and delete duplicate

Example:

ID Name Region Area
23 Red US East
42 Blue Aus NA
324 Green US North
243 Purple US All
243 Purple Can All
32 Black US West
23 Red Can East

What I would like:

ID Name Region Area
23 Red US, Can East
42 Blue Aus NA
324 Green US North
243 Purple US, Can All
32 Black US West

The issue I am running into is that I can't set a macro to concatenate easily because there are columns before and after the column I'd like to concatenate. Any assistance in this matter would be greatly appreciated. Thanks!

I am also attaching an excel example of this.

Sample1.xlsx

What columns do you want to concatenate?

Sub test()
    Dim x As Long
    Dim last_Row As Long

    last_Row = Range("A65536").End(xlUp).Row

    For x = 1 To last_Row
        Range("D" & x).Value = Range("A" & x).Value & "," & Range("B" & x).Value
    Next x
End Sub

This above concatenates columns A and B together with a comma in between. The result goes into column D. This won't solve your duplicate problem at the moment.

In this case, it would be Column C, the Region column . . .

Essentially, I would like to look at Column A and for any duplicates values, concatenate Column C with a comma for the duplicates and then delete the duplicate rows.

The code JBeauclaire posted is similar to what I want I think, except that there are columns before and afterwards:

http://www.excelforum.com/excel-prog...uplicates.html

How about

Sub test()
Dim a, i As Long, ii As Long, n As Long
a = Sheets(1).Range("b2").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            n = n + 1
            .Item(a(i, 1)) = n
            For ii = 1 To UBound(a, 2)
                a(n, ii) = a(i, ii)
            Next
        Else
            a(.Item(a(i, 1)), 3) = _
            a(.Item(a(i, 1)), 3) & ", " & a(i, 3)
        End If
    Next
End With
With Sheets(2).Range("b2")
    .CurrentRegion.ClearContents
    .Resize(n, UBound(a, 2)).Value = a
End With
End Sub

The previous script didn't really do anything when I . . . perhaps I'm missing something.

I think I can easily write a script to delete duplicate rows of data. The problem is that ALL the data in the row, other than the region data, is the same. I'd like to combine the region data in that case so that they are in one cell and separated by a comma.

I think I can also write script to combine data into a single cell being separated by a comma, however, I'm running into problems because the regions column has data in both columns to the left and right of it.

If anyone could provide any insight that would be appreciated. Thanks!

I don't understand what you are talking about.

It is working.

Sample1WithCode.xlsm

All right . . . I tried to put it into a command button and must have messed up. I actually wanted it to replace the information on Sheet 1 so I just changed the code to paste onto Sheet 1. Thank you for all the help

Thank you so much for the help!

I had one quick question. Would it be possible to scan for duplicates and only concatenate the Region data that is different? i.e if I have:

ID Name Region Area
23 Red US East
23 Red US East

I would just delete the extra row, but if I had:

ID Name Region Area
23 Red US East
23 Red Can East

It would become:

ID Name Region Area
23 Red US, Can East

Thank you for the help once again!

Sorry to ask again but I just had a request and I'm not sure if it was possible but, is it possible to add in an input box for the column that I want to concatenate? ie, if I want to concatenate column 3 instead of 4, is it possible to put a pop up box that prompts for what column to combine?

Your last post is not clear to me.

What if the data like


ID Name Region Area
23 Red US East
23 Red Can East

And you select "Area" to be concatenated.

Need the detailed data with the desired result in Excel

Than you for the response.

I had two questions: a) Currently, the code is concatenating everything in the the indicated column. I was wondering if there was a method to only concatenate if the values in the column are different.

b) if I'd like to have the user select what column to concatenate, instead of having a set column coded in, is it possible to do it via a input box?

I've attached the spreadsheet and thank you once again!

Sample1WithCode.xlsm

You are not answering to my last question.

Sub test()
Dim a, i As Long, ii As Long, n As Long, w()
Dim txt As String, temp As String, refCol As Long
refCol = Application.InputBox("Select column", Type:=8).Column
ReDim w(1 To 2)
With Sheets(1).Range("b2").CurrentRegion
    a = .Value
    refCol = refCol - .Column + 1
End With
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a, 1)
        txt = a(i, 1) & ";;" & a(i, 2)
        temp = ""
        If Not .exists(txt) Then
            n = n + 1
            For ii = 1 To UBound(a, 2)
                a(n, ii) = a(i, ii)
                temp = temp & ";;" & a(i, ii)
            Next
            Set w(1) = _
            CreateObject("Scripting.Dictionary")
            w(1).CompareMode = 1
            w(1)(temp) = Empty
            w(2) = n
            .Item(txt) = w
        Else
            For ii = 1 To UBound(a, 2)
                temp = temp & ";;" & a(i, ii)
            Next
            If Not .Item(txt)(1).exists(temp) Then
                a(.Item(txt)(2), refCol) = _
                a(.Item(txt)(2), refCol) & ", " & a(i, refCol)
                .Item(txt)(1)(temp) = Empty
            End If
        End If
    Next
End With
With Sheets(2).Range("b2")
    .CurrentRegion.ClearContents
    .Resize(n, UBound(a, 2)).Value = a
End With
End Sub

Sorry about that . . .

If Area is selected, to be concatenated, I'd expect it not return just:

ID Name Region Area
23 Red US East

since there is only East in Area. Ideally, I would like it to scan through the row and if there are values in a column that are not the same, to concatenate, but I don't think that would be easy. In reality, the only column I expect to have data that is different is the Region, but the reason I am asking for the ability to select different columns is because sometimes in different worksheets, the Region metric will be located in different columns (ie, instead of 3, it may be in 6).

Sorry for the confusion.

Works great, thanks for all the help!

Sorry for the confusion again . . . I realized that the current code after running deletes out some of the cells where I have formulas. Is there a solution to this?