Transpose Issue from Columns to Rows...

[Lynndyhop]

Hi there,

Can't quite wrap my head around this one. I have the following data:

Ee# Contact Type Contact
1 Home P 111-2222
1 Email (e-mail address removed)
2 Home P 222-3333
3 Home P 333-4444
3 Mobile 444-5555
3 Email (e-mail address removed)
4 Mobile 555-6666

And need to make this

Ee# Home P Mobile Email
1 111-2222 - (e-mail address removed)
2 222-3333
3 333-4444 444-5555 (e-mail address removed)
4 555-6666


Any suggestions?

Many thanks,

 

[Rodriques]

Hi,

Filter the excel file that you have & then filter the contact type eg: Home
P, Email & Mobile Copy Paste in a new excel as you want.

Bye.

 

[Lynndyhop]

Thanks Rodriques,

I tried that, but since you don't know how many contacts each person has,
copying and pasting the filters runs a risk of mixing up records.

I think I figured out a way - I created a new column that added EE#and
Contact Type together, then did a vlookup that matched to this column by
combining the Column Heading and the Ee# on each row. I then used a pivot
table to get one row for each ee#.


Thanks again,

 

[Dave Peterson]

Is a macro ok?

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim oRow As Long
Dim oCol As Long
Dim res As Variant

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'sort original range by Id, name, period
With .Range("a1:C" & LastRow)
.Sort key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
header:=xlYes
End With

'Get a list of unique contact types
.Range("b1:b" & LastRow).AdvancedFilter _
action:=xlFilterCopy, unique:=True, copytorange:=NewWks.Range("A1")
End With

With NewWks
With .Range("a:a")
.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With

.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy
.Range("b1").PasteSpecial Transpose:=True
.Columns(1).Clear
.Range("A1").Value = "EE#"

End With

With CurWks
oRow = 1
For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value <> .Cells(iRow - 1, "A").Value Then
'different EE#
oRow = oRow + 1
'new EE# in column A
NewWks.Cells(oRow, "A").Value = .Cells(iRow, "A").Value
End If
oCol = Application.Match(.Cells(iRow, "B").Value, NewWks.Rows(1), 0)
If IsError(oCol) Then
'this shouldn't happen
MsgBox "Error with row: " & iRow
Exit Sub
Else
NewWks.Cells(oRow, oCol).Value = .Cells(iRow, "C").Value
End If
Next iRow
End With

NewWks.UsedRange.Columns.AutoFit

End Sub


If you're new to macros:

Debra Dalgleish has some notes how to implement macros here:
http://www.contextures.com/xlvba01.html

David McRitchie has an intro to macros:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Ron de Bruin's intro to macros:
http://www.rondebruin.nl/code.htm

(General, Regular and Standard modules all describe the same thing.)

 

[Teethless mama]

Assume your data in Sheet1 A1:C8

In Sheet2:
Header in row1

In B2:
=IF(ISNA(MATCH(1,(Sheet1!$A$2:$A$8=$A2)*(Sheet1!$B$2:$B$8=B$1),0)),"",INDEX(Sheet1!$C$2:$C$8,MATCH(1,(Sheet1!$A$2:$A$8=$A2)*(Sheet1!$B$2:$B$8=B$1),0)))

ctrl+shift+enter, not just enter
copy across and down