Grouping in one row

J

Johan Ibrahim

Hi

I have following problem, i have 5 columns of data, the first column
is ID number. There can be many rows with the same ID. What I want to
achieve is to group values from one ID in one row.

For example I have:

a,cat,excel,12, ,4
a,2,4, ,fire
a, ,fire,543,12
b,qwerty,six,alpha,3
b,34,enter, ,3
c,with,sober,lax,23
c,2, ,4,3

and want to get:

a,cat,excel,12, ,4,2,4, ,fire, ,fire,543,12
b,qwerty,six,alpha,3,34,enter, 3
c,with,sober,lax,23,2, 4,3

Can this be done in excel or vba?
 
P

Puppet_Sock

Hi

I have following problem, i have 5 columns of data, the first column
is ID number. There can be many rows with the same ID. What I want to
achieve is to group values from one ID in one row.

For example I have:

a,cat,excel,12, ,4
a,2,4, ,fire
a, ,fire,543,12
b,qwerty,six,alpha,3
b,34,enter, ,3
c,with,sober,lax,23
c,2, ,4,3

and want to get:

a,cat,excel,12, ,4,2,4, ,fire, ,fire,543,12
b,qwerty,six,alpha,3,34,enter, 3
c,with,sober,lax,23,2, 4,3

Can this be done in excel or vba?

It could certainly be done in VBA. How difficult it would be
depends on if the sorting in your example is dependable.
That is, is the ID column always sorted? It's a fairly
straightforward thing then. You just move the cells up
when the ID is the same as the previous row. This would
seem to produce more than five columns. Is that OK?
And it seems to not bother about duplicates. Is that OK?
Socks
 
D

Don Guillett

Hi

I have following problem, i have 5 columns of data, the first column
is ID number. There can be many rows with the same ID. What I want to
achieve is to group values from one ID in one row.

For example I have:

a,cat,excel,12, ,4
a,2,4, ,fire
a, ,fire,543,12
b,qwerty,six,alpha,3
b,34,enter, ,3
c,with,sober,lax,23
c,2, ,4,3

and want to get:

a,cat,excel,12, ,4,2,4, ,fire, ,fire,543,12
b,qwerty,six,alpha,3,34,enter, 3
c,with,sober,lax,23,2, 4,3

Can this be done in excel or vba?

Sub columnstorowsSAS()
Dim i As Long
Dim slc As Long
Dim dlc As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i + 1, 1) = Cells(i, 1) Then
slc = Cells(i + 1, Columns.Count).End(xlToLeft).Column
'MsgBox slc
dlc = Cells(i, Columns.Count).End(xlToLeft).Column + 1
'MsgBox dlc
Cells(i + 1, 1).Resize(, slc).Copy Cells(i, dlc)
Rows(i + 1).Delete
End If
Next i
End Sub
 
R

Ron Rosenfeld

Hi

I have following problem, i have 5 columns of data, the first column
is ID number. There can be many rows with the same ID. What I want to
achieve is to group values from one ID in one row.

For example I have:

a,cat,excel,12, ,4
a,2,4, ,fire
a, ,fire,543,12
b,qwerty,six,alpha,3
b,34,enter, ,3
c,with,sober,lax,23
c,2, ,4,3

and want to get:

a,cat,excel,12, ,4,2,4, ,fire, ,fire,543,12
b,qwerty,six,alpha,3,34,enter, 3
c,with,sober,lax,23,2, 4,3

Can this be done in excel or vba?

Relatively easy to do with a macro. You do not write where you want the results, so in this example I placed them adjacent to (starting in column H) your original data. But if it works OK, that can easily be changed. Also, this macro, does not expect that the data will be sorted. It does not sort the results, either, but that could easily be added.

Finally, it assumes your data starts in A1, and, like your example, has no column labels; again, an easy change to make if that is not the case.

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.

Once satsfied, UNcommenting the Application.Screenupdating = False line will speed up execution.

======================================
Option Explicit
Sub CombineRows()
Dim rSrc As Range, rDest As Range, c As Range
Dim vSrc As Variant, vRes As Variant
Dim v1 As Variant, v2() As String
Dim collSrc As Collection
Dim i As Long, j As Long
Dim sTemp As String
Dim sFirstAddress As String


'Application.ScreenUpdating = False

Set rSrc = ActiveSheet.Range("a1").CurrentRegion
Set rDest = rSrc(1, rSrc.Columns.Count + 2)
rDest.CurrentRegion.Clear

'get list of unique ID's
Set collSrc = New Collection
On Error Resume Next
For Each c In rSrc.Columns(1).Cells
collSrc.Add Item:=c.Text, Key:=CStr(c.Text)
Next c
On Error GoTo 0

'Build Results array
ReDim vRes(1 To collSrc.Count, 0 To 1)
For i = 1 To collSrc.Count
vRes(i, 0) = collSrc(i)
Set c = rSrc.Find(what:=vRes(i, 0), _
after:=rSrc(rSrc.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext, MatchCase:=True)
sFirstAddress = c.Address
Do
v1 = Range(c.Offset(columnoffset:=1), _
c(columnindex:=Columns.Count).End(xlToLeft))
ReDim v2(1 To UBound(v1, 2))
For j = LBound(v2) To UBound(v2)
v2(j) = v1(1, j)
Next j
vRes(i, 1) = vRes(i, 1) & "," & Join(v2, ",")

Set c = rSrc.FindNext(after:=c)
Loop While c.Address <> sFirstAddress
vRes(i, 1) = Mid(vRes(i, 1), 2)

Next i

Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=2)
rDest = vRes
rDest.Columns(2).TextToColumns comma:=True, Tab:=False, semicolon:=False, _
Space:=False, other:=False


Application.ScreenUpdating = True
End Sub
================================
 
R

Ron Rosenfeld

Relatively easy to do with a macro. You do not write where you want the results, so in this example I placed them adjacent to (starting in column H) your original data. But if it works OK, that can easily be changed. Also, this macro, does not expect that the data will be sorted. It does not sort the results, either, but that could easily be added.

Finally, it assumes your data starts in A1, and, like your example, has no column labels; again, an easy change to make if that is not the case.

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.

Once satsfied, UNcommenting the Application.Screenupdating = False line will speed up execution.

Minor change, to limit the Find method to just column 1 of the data. I had that initially, but removed it for debugging, then forgot to add it back in.

================================
Option Explicit
Sub CombineRows()
Dim rSrc As Range, rDest As Range, c As Range
Dim vSrc As Variant, vRes As Variant
Dim v1 As Variant, v2() As String
Dim collSrc As Collection
Dim i As Long, j As Long
Dim sTemp As String
Dim sFirstAddress As String

'UNcomment next line to speed up macro
'Application.ScreenUpdating = False

Set rSrc = ActiveSheet.Range("a1").CurrentRegion
Set rDest = rSrc(1, rSrc.Columns.Count + 2)
rDest.CurrentRegion.Clear

'get list of unique ID's
Set collSrc = New Collection
On Error Resume Next
For Each c In rSrc.Columns(1).Cells
collSrc.Add Item:=c.Text, Key:=CStr(c.Text)
Next c
On Error GoTo 0

'Build Results array
ReDim vRes(1 To collSrc.Count, 0 To 1)

With rSrc.Columns(1)
For i = 1 To collSrc.Count
vRes(i, 0) = collSrc(i)
Set c = .Find(what:=vRes(i, 0), _
after:=rSrc(rSrc.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext, MatchCase:=True)
sFirstAddress = c.Address
Do
v1 = Range(c.Offset(columnoffset:=1), _
c(columnindex:=Columns.Count).End(xlToLeft))
ReDim v2(1 To UBound(v1, 2))
For j = LBound(v2) To UBound(v2)
v2(j) = v1(1, j)
Next j
vRes(i, 1) = vRes(i, 1) & "," & Join(v2, ",")

Set c = .FindNext(after:=c)

Loop While c.Address <> sFirstAddress
vRes(i, 1) = Mid(vRes(i, 1), 2)
Next i
End With

Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=2)
rDest = vRes
rDest.Columns(2).TextToColumns comma:=True, Tab:=False, semicolon:=False, _
Space:=False, other:=False


Application.ScreenUpdating = True
End Sub
=====================================
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top