PDA

View Full Version : Need Macro Help for making Transpose List



rohit1409
08-28-2016, 10:59 PM
Dear All Macro Guru's,

I have a file in the following format

A B C D
1 CostCentre Basic HRA Fixed
2 880001 3000 1000 1500
3 880002 4000 2000 2500
4 880003 1000 5500 3500
5 880004 400 200 4500
6 880005 500 750 500


Output required using macro...

CostCentre Account Amount
880001 Basic 3000
880002 Basic 4000
880003 Basic 1000
880004 Basic 400
880005 Basic 500
880001 HRA 3000
880002 HRA 4000
880003 HRA 1000
880004 HRA 400
880005 HRA 500
880001 Fixed 1500
880002 Fixed 2500
880003 Fixed 3500
880004 Fixed 4500
880005 Fixed 500


Now the catch is "cost center" field is not fixed and nor does the "account heads" fields Basic, HRA, Fixed.. these can be more or less... the range can extends to 50 cost centers and 25 account heads...

Request you to kindly suggest a macro for the same... appreciate your help here...

Please let me know if any other information is required... Thanks

snb
08-29-2016, 02:55 AM
It has been answered so many times for your fellow countrymen, please use this forum's search function.

We don't like crossposting:

http://www.excelguru.ca/forums/showthread.php?6648-Need-Macro-Help-for-making-Transpose-List

p45cal
08-29-2016, 03:32 AM
wholesale cross posting sans links:
http://www.excelguru.ca/forums/showthread.php?6648-Need-Macro-Help-for-making-Transpose-List&p=27162&posted=1#post27162
http://answers.microsoft.com/en-us/office/forum/office_2010-excel/need-macro-to-transpose-list/7990ad60-baf6-4672-ae49-8263cc1a6ba8?auth=1
http://www.mrexcel.com/forum/excel-questions/961491-need-macro-making-transpose-list.html
http://www.ozgrid.com/forum/showthread.php?t=200951

Paul_Hossler
08-29-2016, 04:53 PM
In case you didn't get an answer on the other forums




Option Explicit

Sub OnceAgain_WithFeeling()

Dim rData As Range, rSort As Range, rSort1 As Range
Dim wsData As Worksheet, wsOut As Worksheet
Dim iRow As Long, iCol As Long, iOut As Long

Application.ScreenUpdating = False

Set wsData = ActiveSheet
Set rData = wsData.Cells(1, 1).CurrentRegion
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(wsData.Name & "_List").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Worksheets.Add.Name = wsData.Name & "_List"
Set wsOut = Worksheets(wsData.Name & "_List")
iOut = 1
With wsOut
.Cells(iOut, 1).Value = "Cost Center"
.Cells(iOut, 2).Value = "Account"
.Cells(iOut, 3).Value = "Amount"
iOut = iOut + 1

For iRow = 2 To rData.Rows.Count
For iCol = 2 To rData.Columns.Count
.Cells(iOut, 1).Value = rData.Cells(iRow, 1).Value
.Cells(iOut, 2).Value = rData.Cells(1, iCol).Value
.Cells(iOut, 3).Value = rData.Cells(iRow, iCol).Value
iOut = iOut + 1
Next iCol
Next iRow

Set rSort = .Cells(1, 1).CurrentRegion
Set rSort1 = rSort.Cells(2, 1).Resize(rSort.Rows.Count - 1, rSort.Columns.Count)

With .Sort
.SortFields.Clear
.SortFields.Add Key:=rSort1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rSort1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange rSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

.Range("A2").Select
ActiveWindow.FreezePanes = True
.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

End With
Application.ScreenUpdating = True
End Sub