Removing duplicates but keeping data

Brett

New Member
Joined
Jun 12, 2002
Messages
18
A sheet has data in the following format:
Swan Matthew ICT G
Swan Matthew Maths D
Swan Matthew PE C
Swan Matthew Res Mats C
Swan Matthew Res Mats C
Swan Matthew Science C
Swan Matthew Science C
Taylor Colin Eng Lit. B
Taylor Colin English C
Taylor Colin French B
Taylor Colin Geog B
Taylor Colin ICT E
Taylor Colin Maths B
Taylor Colin PE B
Taylor Colin Res Mats C
Taylor Colin Science C
Taylor Colin Science C
Thomas Helen Art AA
Thomas Helen Eng Lit. AA
Thomas Helen English A
Thomas Helen French B
Thomas Helen History A

Does anyone know how do we change the sheet so that duplicate names are removed and the subjects go across the sheet instead of down?

The required format is
Name Art English English Lit. French History etc etc
Thomas Helen AA AA A B A
Taylor Colin etc etc
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Jim North

MrExcel MVP
Joined
Jun 20, 2002
Messages
791
Hi Brett,

My suggestion would be a VBA subprocedure (a macro). You would need to decide in advance what subjects would go into what columns. Is the name in one cell or two?
 

Brett

New Member
Joined
Jun 12, 2002
Messages
18
It is in two columns though there is no reason why the names cannot be concatenated.
 

Jim North

MrExcel MVP
Joined
Jun 20, 2002
Messages
791
This is what I did in a similar situation:

The source worksheet:
chris sample jim.xls
ABCD
1DonGraca
2Company:DepotExpress
3E-mail:
4WorkPhone:(714)457-1800
5Fax:(714)457-9027
6Chapter:Toledo
7Title:
8
9ArnoldDauza
10Company:PlumbingMart
11E-mail:
12WorkPhone:(916)848-6112
13Fax:
14Chapter:ST.LOUIS
15Title:AccountManager
16OtherAddresses
17
18
19SusanCasby
20Chapter:NEWJERSEY
Sheet1


The result:
chris sample jim.xls
ABCDEFGH
1NameCompanyE-mailWorkPhoneFaxChapterTitle
2DonGracaDepotExpressDaraca@tlision.com(714)457-1800(714)457-9027Toledo
3ArnoldDauzaPlumbingMartarnolddauza@hotmail.com(916)848-6112ST.LOUISAccountManager
4SusanCasbyNEWJERSEY
5RajSingerDirector
6FrankGoodrichSevenNorthfgoodric100@hotmail.com(913)457-1800(714)857-9027TRENTON
7
Sheet2


The code that did the work:<pre>
Sub TransposeData()
'
' TransposeData
' 7/30/2002 by Jim North
'
Dim rwIndex As Long
Dim colIndex As Long
Dim NamePrinted As Boolean
Dim NewrowNbr As Long
Dim NewSet As Boolean
Dim RowCount As Long
Dim strData As String
Dim strTestCell As String
Dim ColumnToLoad As Integer

Application.ScreenUpdating = False

' Insert Headings
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("A:G").Clear
Range("A1").Value = "Name"
Range("B1").Value = "Company"
Range("C1").Value = "E-mail"
Range("D1").Value = "Work Phone"
Range("E1").Value = "Fax"
Range("F1").Value = "Chapter"
Range("G1").Value = "Title"

With Range("A1:G1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With

NewrowNbr = 1
rwIndex = 1
'Get the number of rows used
Worksheets("Sheet1").Activate
RowCount = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

' loop thru all the data rows
Do Until rwIndex >= RowCount

' use the do statement to load columns 2 thru 9 (B thru I)
strTestCell = Cells(rwIndex, 1).Value
ColumnToLoad = 0
strData = Cells(rwIndex, 2).Value

Select Case strTestCell
' Blank line
Case ""
NewSet = True
NamePrinted = False

' Company
Case "Company:"
ColumnToLoad = 2

' E-mail:
Case "E-mail:"
If strData<> "" Then
strData = Cells(rwIndex, 2).Hyperlinks(1).Address()
strData = Right(strData, Len(strData) - 7)
End If
ColumnToLoad = 3

' Work Phone:
Case "Work Phone:"
ColumnToLoad = 4

' Fax:
Case "Fax:"
ColumnToLoad = 5

' Chapter:
Case "Chapter:"
ColumnToLoad = 6

' Title:
Case "Title:"
ColumnToLoad = 7

' Name
Case Else
If NamePrinted = False Then
If rwIndex = 1 Or NewSet = True Then
NewrowNbr = NewrowNbr + 1 'move to the next new data row
ColumnToLoad = 1
strData = strTestCell
NewSet = False
NamePrinted = True
End If
End If
End Select

If ColumnToLoad > 0 Then
Worksheets("Sheet2").Cells(NewrowNbr, ColumnToLoad).Value = strData
End If

rwIndex = rwIndex + 1 'read the next row of data
Loop

Application.ScreenUpdating = True

Worksheets("Sheet2").Activate
Columns("A:G").Select
Selection.Columns.AutoFit
Range("A1").Select

End Sub</pre>

Hope this helps!
 

Brett

New Member
Joined
Jun 12, 2002
Messages
18
Thanks for the reply though I was hoping that I could do this without going down the VB road.

Brett
This message was edited by Brett on 2002-09-10 00:23
 

Watch MrExcel Video

Forum statistics

Threads
1,130,046
Messages
5,639,757
Members
417,108
Latest member
Thein Than

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
Top