Transpose data
 

Is there way in Excel I can transpose the data show her in "Original" to
"Required" format [the alignment of data did not copy exactly].
In the Required format the Original column names are changed to code numbers

Original Format
Emp No Date Charge Rent Service Furniture
005083 14/07/2006 88 71 0 17
000086 16/07/2006 107 107 0 0
000093 15/07/2006 193 176 0 17
005715 14/07/2006 222 222 0 0
008957 16/07/2006 300 300 0 0

Required Format Code 7154 7155 7156 7157
Emp No Date Code Charge Rent Service Furniture
005083 14/07/2006 7154 88
005083 14/07/2006 7155 71
005083 14/07/2006 7156 0
005083 14/07/2006 7157 17
000086 16/07/2006 7154 107
000086 16/07/2006 7155 107
000086 16/07/2006 7156 0
000086 16/07/2006 7157 0
000093 15/07/2006 7154 193
000093 15/07/2006 7155 176
000093 15/07/2006 7156 0
000093 15/07/2006 7157 17

Thanks

Mike

Transpose data
 

Mike,

Change your column headings to the required codes (so it looks like this):

Emp No Date 7154 7155 7156 7157
005083 14/07/2006 88 71 0 17
000086 16/07/2006 107 107 0 0
000093 15/07/2006 193 176 0 17
005715 14/07/2006 222 222 0 0
008957 16/07/2006 300 300 0 0

Then select a cell in your table, and run the macro below. And answer "2" when asked how many
columns to treat as row fields.

HTH,
Bernie
MS Excel MVP

Sub MakeTable2()
Dim myCell As Range
Dim newSheet As Worksheet
Dim mySheet As Worksheet
Dim i As Long
Dim j As Integer
Dim k As Long
Dim l As Integer
Dim mySelection As Range
Dim RowFields As Integer

Set mySheet = ActiveSheet
Set mySelection = ActiveCell.CurrentRegion
RowFields = Application.InputBox( _
"How many left-most columns to treat as row fields?", _
"CrossTab to DataBase Helper", 1, , , , , 1)
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("New Database").Delete
Application.DisplayAlerts = True
Set newSheet = Worksheets.Add
newSheet.Name = "New Database"
mySheet.Activate
i = 1
For j = mySelection(1).Row + 1 To _
mySelection(mySelection.Cells.Count).Row
For k = mySelection(1).Column + RowFields To _
mySelection(mySelection.Cells.Count).Column
If mySheet.Cells(j, k).Value < "" Then
For l = 1 To RowFields
newSheet.Cells(i, l).Value = _
Cells(j, mySelection(l).Column).Value
Next l
newSheet.Cells(i, RowFields + 1).Value = _
Cells(mySelection(1).Row, k).Value
newSheet.Cells(i, RowFields + 2).Value = _
Cells(j, k).Value
i = i + 1
End If
Next k
Next j

End Sub



"Mike" wrote in message
...
Is there way in Excel I can transpose the data show her in "Original" to
"Required" format [the alignment of data did not copy exactly].
In the Required format the Original column names are changed to code numbers

Original Format
Emp No Date Charge Rent Service Furniture
005083 14/07/2006 88 71 0 17
000086 16/07/2006 107 107 0 0
000093 15/07/2006 193 176 0 17
005715 14/07/2006 222 222 0 0
008957 16/07/2006 300 300 0 0

Required Format Code 7154 7155 7156 7157
Emp No Date Code Charge Rent Service Furniture
005083 14/07/2006 7154 88
005083 14/07/2006 7155 71
005083 14/07/2006 7156 0
005083 14/07/2006 7157 17
000086 16/07/2006 7154 107
000086 16/07/2006 7155 107
000086 16/07/2006 7156 0
000086 16/07/2006 7157 0
000093 15/07/2006 7154 193
000093 15/07/2006 7155 176
000093 15/07/2006 7156 0
000093 15/07/2006 7157 17

Thanks

Mike

Transpose data
 

thanks mike that was helpful.

"Mike" wrote:

Is there way in Excel I can transpose the data show her in "Original" to
"Required" format [the alignment of data did not copy exactly].
In the Required format the Original column names are changed to code numbers

Original Format
Emp No Date Charge Rent Service Furniture
005083 14/07/2006 88 71 0 17
000086 16/07/2006 107 107 0 0
000093 15/07/2006 193 176 0 17
005715 14/07/2006 222 222 0 0
008957 16/07/2006 300 300 0 0

Required Format Code 7154 7155 7156 7157
Emp No Date Code Charge Rent Service Furniture
005083 14/07/2006 7154 88
005083 14/07/2006 7155 71
005083 14/07/2006 7156 0
005083 14/07/2006 7157 17
000086 16/07/2006 7154 107
000086 16/07/2006 7155 107
000086 16/07/2006 7156 0
000086 16/07/2006 7157 0
000093 15/07/2006 7154 193
000093 15/07/2006 7155 176
000093 15/07/2006 7156 0
000093 15/07/2006 7157 17

Thanks

Mike