How to Combine Grouped Records onto one row
 

I have a spreadsheet that looks like this:
TYPE BIN KEY
BOOK ABC A513
BOOK ABC B134
BOOK DEF W222
BOOK DEF A678
BOOK DEF N890
BOOK DEF N333
BOOK XYZ D444
BOOK XYZ E555
BOOK XYZ F777

I want to be able to combine the records with same TYPE/BIN onto one row
putting the different keys into the same cell, like this:

TYPE BIN KEY
BOOK ABC A513, B134
BOOK DEF W222, A678, N890, N333
BOOK XYZ D444, E555, F777

Is there a way to do this?
Thanks,
Lynn


--
Message posted via http://www.officekb.com

How to Combine Grouped Records onto one row
 

Lynn

Assuming your data starts in cell A1, save your book and then try this:

Sub MoveData()

Dim thisSht As Worksheet
Dim newSht As Worksheet
Dim Typ As String
Dim Bin As String
Dim Key As String
Dim TypBin As String
Dim ColA As Range
Dim Cell As Range
Dim endRow As Long
Dim fndCell As Range

Application.ScreenUpdating = False

Set thisSht = ActiveSheet
endRow = Cells(Rows.Count, 1).End(xlUp).Row
Set ColA = Range(Cells(2, 1), Cells(endRow, 1))

Set newSht = Sheets.Add

thisSht.Range("A1:C1").Copy Destination:=newSht.Range("B1:D1")
For Each Cell In ColA
Typ = Cell.Value
Bin = Cell.Offset(0, 1).Value
Key = Cell.Offset(0, 2).Value
TypBin = Typ & Bin
With newSht.Columns(1)
Set fndCell = .Find(TypBin, LookIn:=xlValues)
End With
If fndCell Is Nothing Then
With newSht
endRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Cells(endRow, 1).Value = TypBin
.Cells(endRow, 2).Value = Typ
.Cells(endRow, 3).Value = Bin
.Cells(endRow, 4).Value = Key
End With
Else
fndCell.Offset(0, 3).Value = fndCell.Offset(0, 3).Value _
& ", " & Key
End If
Next Cell

newSht.Cells(1, 1).EntireColumn.Delete

Application.ScreenUpdating = True

End Sub

Hope this helps
Rowan

"Lynn H via OfficeKB.com" wrote:


I have a spreadsheet that looks like this:
TYPE BIN KEY
BOOK ABC A513
BOOK ABC B134
BOOK DEF W222
BOOK DEF A678
BOOK DEF N890
BOOK DEF N333
BOOK XYZ D444
BOOK XYZ E555
BOOK XYZ F777

I want to be able to combine the records with same TYPE/BIN onto one row
putting the different keys into the same cell, like this:

TYPE BIN KEY
BOOK ABC A513, B134
BOOK DEF W222, A678, N890, N333
BOOK XYZ D444, E555, F777

Is there a way to do this?
Thanks,
Lynn


--
Message posted via http://www.officekb.com

How to Combine Grouped Records onto one row
 

Thanks for your help Rowan, this does exactly what I need!

Lynn


Rowan wrote:
Lynn

Assuming your data starts in cell A1, save your book and then try this:

Sub MoveData()

Dim thisSht As Worksheet
Dim newSht As Worksheet
Dim Typ As String
Dim Bin As String
Dim Key As String
Dim TypBin As String
Dim ColA As Range
Dim Cell As Range
Dim endRow As Long
Dim fndCell As Range

Application.ScreenUpdating = False

Set thisSht = ActiveSheet
endRow = Cells(Rows.Count, 1).End(xlUp).Row
Set ColA = Range(Cells(2, 1), Cells(endRow, 1))

Set newSht = Sheets.Add

thisSht.Range("A1:C1").Copy Destination:=newSht.Range("B1:D1")
For Each Cell In ColA
Typ = Cell.Value
Bin = Cell.Offset(0, 1).Value
Key = Cell.Offset(0, 2).Value
TypBin = Typ & Bin
With newSht.Columns(1)
Set fndCell = .Find(TypBin, LookIn:=xlValues)
End With
If fndCell Is Nothing Then
With newSht
endRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Cells(endRow, 1).Value = TypBin
.Cells(endRow, 2).Value = Typ
.Cells(endRow, 3).Value = Bin
.Cells(endRow, 4).Value = Key
End With
Else
fndCell.Offset(0, 3).Value = fndCell.Offset(0, 3).Value _
& ", " & Key
End If
Next Cell

newSht.Cells(1, 1).EntireColumn.Delete

Application.ScreenUpdating = True

End Sub

Hope this helps
Rowan

I have a spreadsheet that looks like this:
TYPE BIN KEY
[quoted text clipped - 19 lines]
Thanks,
Lynn


--
Message posted via http://www.officekb.com