Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default If value in a colum the same concatenate another colume

Hi
This is tricky to explain so I will show the output I want below, basically if the same unique value is in one column I would like to concatenate values from those unique value in the existing column to create one row. Easier to demonstrate. I wonder would anyone know some macro code to achieve this..


Head1 Head2
123 joe
154 steve
123 tom
129 kate

to give


head1 head2
123 joe,tom
154 steve
129 kate

Thank you for any help
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default If value in a colum the same concatenate another colume

On Friday, August 30, 2013 5:09:58 PM UTC-7, wrote:
Hi

This is tricky to explain so I will show the output I want below, basically if the same unique value is in one column I would like to concatenate values from those unique value in the existing column to create one row. Easier to demonstrate. I wonder would anyone know some macro code to achieve this.





Head1 Head2

123 joe

154 steve

123 tom

129 kate



to give





head1 head2

123 joe,tom

154 steve

129 kate



Thank you for any help


Try this, From my archives, I don't recall the author.

Option Explicit

Sub Test()
Dim LRow1 As Long
Dim LRow2 As Long
Dim i As Long
Dim j As Long
Dim rngC As Range
Dim c As Range
Dim firstAddress As String
Dim myStr As String

j = 1
LRow1 = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LRow1
If WorksheetFunction.CountIf(Range(Cells(1, 1), _
Cells(i, 1)), Cells(i, 1)) = 1 Then
Cells(j, 3) = Cells(i, 1)
j = j + 1
End If
Next

LRow2 = Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In Range("C1:C" & LRow2)
myStr = ""
With Range("A1:A" & LRow1)
Set c = .Find(rngC, after:=Cells(LRow1, 1), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
myStr = myStr & c.Offset(0, 1) & ", "
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
rngC.Offset(0, 1) = Left(myStr, Len(myStr) - 2)
End If
End With
Next
End Sub
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default If value in a colum the same concatenate another colume

Hi again,

Am Sat, 31 Aug 2013 11:11:18 +0200 schrieb Claus Busch:

to do it in place try:

Sub Test()


with the code in last answer you get an error if a number exists only
one time.
Better try:

Sub Test()
Dim rngC As Range
Dim c As Range
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A2:A" & LRow)
If WorksheetFunction.CountIf(Range(Cells(rngC.Row, 1), _
Cells(LRow, 1)), rngC) 1 Then
Do
With Range(Cells(rngC.Row + 1, 1), Cells(LRow, 1))
Set c = .Find(rngC, Cells(LRow, 1), xlValues).Offset(, 1)
If Not c Is Nothing Then
rngC.Offset(, 1) = rngC.Offset(, 1) & ", " & c
Rows(c.Row).Delete
LRow = LRow - 1
End If
End With
Loop While WorksheetFunction.CountIf( _
Range(Cells(rngC.Row, 1), Cells(LRow, 1)), rngC) 1
End If
Next
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default If value in a colum the same concatenate another colume

On Saturday, August 31, 2013 10:18:56 AM UTC+1, Claus Busch wrote:
Hi again,



Am Sat, 31 Aug 2013 11:11:18 +0200 schrieb Claus Busch:



to do it in place try:




Sub Test()




with the code in last answer you get an error if a number exists only

one time.

Better try:



Sub Test()

Dim rngC As Range

Dim c As Range

Dim LRow As Long



LRow = Cells(Rows.Count, 1).End(xlUp).Row

For Each rngC In Range("A2:A" & LRow)

If WorksheetFunction.CountIf(Range(Cells(rngC.Row, 1), _

Cells(LRow, 1)), rngC) 1 Then

Do

With Range(Cells(rngC.Row + 1, 1), Cells(LRow, 1))

Set c = .Find(rngC, Cells(LRow, 1), xlValues).Offset(, 1)

If Not c Is Nothing Then

rngC.Offset(, 1) = rngC.Offset(, 1) & ", " & c

Rows(c.Row).Delete

LRow = LRow - 1

End If

End With

Loop While WorksheetFunction.CountIf( _

Range(Cells(rngC.Row, 1), Cells(LRow, 1)), rngC) 1

End If

Next

End Sub





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2


Thanks Howard, it works perfect but I might use Claus solution as it it works in place and saves a few lines of code for me.

Great answers guys many thanks
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Are there any macros to lock a colum after a colum had been freezed-pane? pejoi Excel Discussion (Misc queries) 0 August 8th 12 04:02 PM
Change from row to colume n colume to row [email protected] Excel Programming 2 October 4th 07 03:35 PM
Keeping a sum colum correct after inserting a colum of data in fro hazel Excel Discussion (Misc queries) 3 October 19th 05 09:51 PM
Check data on colum A and find match on colum b Chris(new user) Excel Discussion (Misc queries) 3 March 20th 05 05:45 PM
How can I look up max of one colume and display the colume to the. Brian Cornejo Excel Worksheet Functions 2 February 21st 05 06:47 AM


All times are GMT +1. The time now is 10:26 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"