Concatenate column B for duplicate values in column A

sarcastress

New Member
Joined
Jul 9, 2008
Messages
13
I swear I have done this before, but I can't remember what I did. I'm sure I would have done it with a formula or ASAP Utilities and not a macro. Maybe someone can jog my memory! I have the following type of data in columns A & B:

[TABLE="width: 156"]
<TBODY>[TR]
[TD]10017</SPAN>
[/TD]
[TD]86703</SPAN>
[/TD]
[/TR]
[TR]
[TD]10017</SPAN>
[/TD]
[TD]86762</SPAN>
[/TD]
[/TR]
[TR]
[TD]10017</SPAN>
[/TD]
[TD]86850</SPAN>
[/TD]
[/TR]
[TR]
[TD]10017</SPAN>
[/TD]
[TD]86900</SPAN>
[/TD]
[/TR]
[TR]
[TD]10017</SPAN>
[/TD]
[TD]86901</SPAN>
[/TD]
[/TR]
[TR]
[TD]10017</SPAN>
[/TD]
[TD]87340</SPAN>
[/TD]
[/TR]
[TR]
[TD]10020</SPAN>
[/TD]
[TD]80053</SPAN>
[/TD]
[/TR]
[TR]
[TD]10020</SPAN>
[/TD]
[TD]80061</SPAN>
[/TD]
[/TR]
[TR]
[TD]10020</SPAN>
[/TD]
[TD]85025</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]80053</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]82306</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]84305</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]84443</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]85025</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]85652</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]86803</SPAN>
[/TD]
[/TR]
</TBODY>[/TABLE]

I would like to end up with this:

[TABLE="width: 383"]
<TBODY>[TR]
[TD]10017</SPAN>
[/TD]
[TD]86703 86762 86850 86900 86901 87340</SPAN>
[/TD]
[/TR]
[TR]
[TD]10020</SPAN>
[/TD]
[TD]80053 80061 85025</SPAN>
[/TD]
[/TR]
[TR]
[TD]10050</SPAN>
[/TD]
[TD]80053 82306 84305 84443 85025 85652 86803</SPAN>
[/TD]
[/TR]
</TBODY>[/TABLE]


So wherever the value in column A repeats, I would like to concatenate the numbers in column B until I hit a new value in column A. If it can only be done with a macro, could someone help a girl out with some VBS? I swear I've done it with a formula in column C and I'm just making it harder than it is, but I'm stumped! Totally need more sleep.

Thanks for any answers you can give.
 
an alternative method than using a collection of dictionary

returned in F:G


Code:
Sub RGEf()
    Dim mVal
    Dim k As Integer
    Dim cnt As Integer
    Dim l As Integer
    Dim V
    l = Range("A:A").Find("*", , , , 1, 2).Row
    cnt = Evaluate("=SUM(--(FREQUENCY($A$1:$A$" & l & ",A1:A" & l & ")>0))")
    For k = 1 To cnt
        mVal = Evaluate("INDEX(A1:A" & l & ",SMALL(if((FREQUENCY(A1:A" & l & ",A1:A" & l & ")>0),ROW(B1:B" & l & "))," & k & "))")
        V = Evaluate("IF(A1:A" & l & "=" & mVal & ", B1:B" & l & ","""")")
        Range("F1").Offset(k - 1) = mVal
        Range("G1").Offset(k - 1) = WorksheetFunction.Trim((Join(Application.Transpose(V), " ")))
    Next
End Sub
 
Last edited:
Upvote 0
Perfect! Thanks so much!


an alternative method than using a collection of dictionary

returned in F:G


Code:
Sub RGEf()
    Dim mVal
    Dim k As Integer
    Dim cnt As Integer
    Dim l As Integer
    Dim V
    l = Range("A:A").Find("*", , , , 1, 2).Row
    cnt = Evaluate("=SUM(--(FREQUENCY($A$1:$A$" & l & ",A1:A" & l & ")>0))")
    For k = 1 To cnt
        mVal = Evaluate("INDEX(A1:A" & l & ",SMALL(if((FREQUENCY(A1:A" & l & ",A1:A" & l & ")>0),ROW(B1:B" & l & "))," & k & "))")
        V = Evaluate("IF(A1:A" & l & "=" & mVal & ", B1:B" & l & ","""")")
        Range("F1").Offset(k - 1) = mVal
        Range("G1").Offset(k - 1) = WorksheetFunction.Trim((Join(Application.Transpose(V), " ")))
    Next
End Sub
 
Upvote 0
My alternative cos I'm not so clever is using more basic VBA but it works just the same and as I wasn't as fast respond I thought I throw it in for fun.

Here it is :

Sub MoveDataUp()
'
' MoveDataUp Macro
'
' Keyboard Shortcut: Ctrl+p

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "END"
Selection.End(xlUp).Select
'
Do Until ActiveCell.Offset(0, 0).Range("A1") = "END"
If ActiveCell.Offset(0, 0).Range("A1") = ActiveCell.Offset(1, 0).Range("A1") Then
Dim Bolt1 As String
Dim Bolt2 As String
Bolt1 = ""
Bolt2 = ""
Bolt1 = ActiveCell.Offset(0, 1).Range("A1")
Bolt2 = ActiveCell.Offset(1, 1).Range("A1")
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = Bolt1 & " " & Bolt2
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.EntireRow.Delete
ActiveCell.Offset(-1, -1).Range("A1").Select
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop
Selection.EntireRow.Delete
End Sub

Cheers
 
Upvote 0
Thanks! Always nice to have options!

My alternative cos I'm not so clever is using more basic VBA but it works just the same and as I wasn't as fast respond I thought I throw it in for fun.

Here it is :

Sub MoveDataUp()
'
' MoveDataUp Macro
'
' Keyboard Shortcut: Ctrl+p

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "END"
Selection.End(xlUp).Select
'
Do Until ActiveCell.Offset(0, 0).Range("A1") = "END"
If ActiveCell.Offset(0, 0).Range("A1") = ActiveCell.Offset(1, 0).Range("A1") Then
Dim Bolt1 As String
Dim Bolt2 As String
Bolt1 = ""
Bolt2 = ""
Bolt1 = ActiveCell.Offset(0, 1).Range("A1")
Bolt2 = ActiveCell.Offset(1, 1).Range("A1")
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = Bolt1 & " " & Bolt2
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.EntireRow.Delete
ActiveCell.Offset(-1, -1).Range("A1").Select
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop
Selection.EntireRow.Delete
End Sub

Cheers
 
Upvote 0
Thanks! Always nice to have options!

Okay, how about a macro that does not use any loops then (also outputted to Columns F and G like VBA Geek's code does)...
Code:
Sub Combine()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("F1:F" & LR) = Evaluate("IF(A1:A" & LR & "=A2:A" & LR + 1 & ","""",A1:A" & LR & ")")
  Range("G1").Value = Range("A1").Value
  Range("G2:G" & LR).Formula = "=IF(A1=A2,G1&"" ""&B2,B2)"
  Range("G2:G" & LR).Value = Range("G2:G" & LR).Value
  Intersect(Range("F1:F" & LR).SpecialCells(xlBlanks).EntireRow, Columns("F:G")).Delete xlShiftUp
End Sub
 
Upvote 0
Oh, great! Thanks, guys! I haven't been this popular since college.

Okay, how about a macro that does not use any loops then (also outputted to Columns F and G like VBA Geek's code does)...
Code:
Sub Combine()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("F1:F" & LR) = Evaluate("IF(A1:A" & LR & "=A2:A" & LR + 1 & ","""",A1:A" & LR & ")")
  Range("G1").Value = Range("A1").Value
  Range("G2:G" & LR).Formula = "=IF(A1=A2,G1&"" ""&B2,B2)"
  Range("G2:G" & LR).Value = Range("G2:G" & LR).Value
  Intersect(Range("F1:F" & LR).SpecialCells(xlBlanks).EntireRow, Columns("F:G")).Delete xlShiftUp
End Sub
 
Upvote 0
Nice!
this one for the first value will return

[TABLE="width: 319"]
<tbody>[TR]
[TD="width: 42, align: right"]10017[/TD]
[TD="width: 277"] -10017 86762 86850 86900 86901 87340[/TD]
[/TR]
</tbody>[/TABLE]
instead of
10017 -86703 86762 86850 86900 86901 87340

the concept is really nice though and its just a small fix :)

Range("G1").Value = Range("A1").Value changed to Range("G1").Value = Range("B1").Value

Okay, how about a macro that does not use any loops then (also outputted to Columns F and G like VBA Geek's code does)...
Code:
Sub Combine()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("F1:F" & LR) = Evaluate("IF(A1:A" & LR & "=A2:A" & LR + 1 & ","""",A1:A" & LR & ")")
  Range("G1").Value = Range("A1").Value
  Range("G2:G" & LR).Formula = "=IF(A1=A2,G1&"" ""&B2,B2)"
  Range("G2:G" & LR).Value = Range("G2:G" & LR).Value
  Intersect(Range("F1:F" & LR).SpecialCells(xlBlanks).EntireRow, Columns("F:G")).Delete xlShiftUp
End Sub
 
Last edited:
Upvote 0
Nice!
this one for the first value will return

[TABLE="width: 319"]
<tbody>[TR]
[TD="width: 42, align: right"]10017[/TD]
[TD="width: 277"] -10017 86762 86850 86900 86901 87340[/TD]
[/TR]
</tbody>[/TABLE]
instead of
10017 -86703 86762 86850 86900 86901 87340

the concept is really nice though and its just a small fix :)

Range("G1").Value = Range("A1").Value changed to Range("G1").Value = Range("B1").Value

Yes, a typo on my part while transferring the test formula in Column C (where I first developed it for proof-of-concept) to Column G because I decided to match your setup (as the OP had already accepted it). Thanks for catching it (I never noticed it during my testing).

For those reading this thread who might want to try my approach, here is the corrected code...
Code:
Sub Combine()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("F1:F" & LR) = Evaluate("IF(A1:A" & LR & "=A2:A" & LR + 1 & ","""",A1:A" & LR & ")")
  Range("G1").Value = Range("B1").Value
  Range("G2:G" & LR).Formula = "=IF(A1=A2,G1&"" ""&B2,B2)"
  Range("G2:G" & LR).Value = Range("G2:G" & LR).Value
  Intersect(Range("F1:F" & LR).SpecialCells(xlBlanks).EntireRow, Columns("F:G")).Delete xlShiftUp
End Sub
 
Last edited:
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top