Concatenate column B for duplicate values in column A

S

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:

10017</SPAN>
86703</SPAN>
10017</SPAN>
86762</SPAN>
10017</SPAN>
86850</SPAN>
10017</SPAN>
86900</SPAN>
10017</SPAN>
86901</SPAN>
10017</SPAN>
87340</SPAN>
10020</SPAN>
80053</SPAN>
10020</SPAN>
80061</SPAN>
10020</SPAN>
85025</SPAN>
10050</SPAN>
80053</SPAN>
10050</SPAN>
82306</SPAN>
10050</SPAN>
84305</SPAN>
10050</SPAN>
84443</SPAN>
10050</SPAN>
85025</SPAN>
10050</SPAN>
85652</SPAN>
10050</SPAN>
86803</SPAN>

<TBODY>
</TBODY>

I would like to end up with this:

10017</SPAN>
86703 86762 86850 86900 86901 87340</SPAN>
10020</SPAN>
80053 80061 85025</SPAN>
10050</SPAN>
80053 82306 84305 84443 85025 85652 86803</SPAN>

<TBODY>
</TBODY>


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.
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
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!


VBA Geek said:
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
Click to expand...
 
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!

ace19852 said:
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
Click to expand...
 
Upvote 0
sarcastress said:
Thanks! Always nice to have options!
Click to expand...

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.

Rick Rothstein said:
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
Click to expand...
 
Upvote 0
Nice!
this one for the first value will return

10017 -10017 86762 86850 86900 86901 87340

<tbody>
</tbody>
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

Rick Rothstein said:
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
Click to expand...
 
Last edited:
Upvote 0
VBA Geek said:
Nice!
this one for the first value will return

10017 -10017 86762 86850 86900 86901 87340

<tbody>
</tbody>
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
Click to expand...

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
You must log in or register to reply here.

Similar threads

E
  • Question
Remove "," from macro output and concatenate values from two column with "/" only when both the cell have same uniqque key in the row
Replies
0
Views
417
exlearner
E
B
  • Question
Trying to concatenate with line breaks based on duplicate values in one column
Replies
2
Views
2K
BradHandley
B

Forum statistics

Threads
1,216,102
Messages
6,128,852
Members
449,471
Latest member
lachbee

Share this page

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