How to bring horizantal data into vertical

Salamullah

Board Regular
Joined
Mar 28, 2011
Messages
221
Hi,

I have month wise data Horizontally which I want to bring vertically with formula, please help.

Horizontal Vertical
Volume Sales Cost Profit ProductAreaMonthVolumeSalesCostProfit
ProductAreaJanFebMar JanFebMar JanFebMar JanFebMar
ABLACK 200 300 151 19,000 28,500 14,345 2,500 7,500 3,775 16,500 21,000 10,570 ABLACKJan200 19,000 2,500 16,500
BBLACK 220 315 171 20,900 29,925 16,245 3,000 7,875 4,275 17,900 22,050 11,970 BBLACKJan220 20,900 3,000 17,900
CRED 240 330 191 22,800 31,350 18,145 3,500 8,250 4,775 19,300 23,100 13,370 CREDJan240 22,800 3,500 19,300
EGREEN 260 345 211 24,700 32,775 20,045 4,000 8,625 5,275 20,700 24,150 14,770 EGREENJan260 24,700 4,000 20,700
DGREEN 280 360 231 26,600 34,200 21,945 4,500 9,000 5,775 22,100 25,200 16,170 DGREENJan280 26,600 4,500 22,100
ABLUE 300 375 251 28,500 35,625 23,845 5,000 9,375 6,275 23,500 26,250 17,570 ABLUEJan300 28,500 5,000 23,500
AGREEN 320 390 271 30,400 37,050 25,745 5,500 9,750 6,775 24,900 27,300 18,970 AGREENJan320 30,400 5,500 24,900
Total 1,820 2,415 1,477 172,900 229,425 140,315 28,000 60,375 36,925 144,900 169,050 103,390 ABLACKFeb300 28,500 7,500 21,000
417,340 BBLACKFeb315 29,925 7,875 22,050
CREDFeb330 31,350 8,250 23,100
EGREENFeb345 32,775 8,625 24,150
DGREENFeb360 34,200 9,000 25,200
ABLUEFeb375 35,625 9,375 26,250
AGREENFeb390 37,050 9,750 27,300
ABLACKMar151 14,345 3,775 10,570
BBLACKMar171 16,245 4,275 11,970
CREDMar191 18,145 4,775 13,370
EGREENMar211 20,045 5,275 14,770
DGREENMar231 21,945 5,775 16,170
ABLUEMar251 23,845 6,275 17,570
AGREENMar271 25,745 6,775 18,970
417,340

<tbody>
</tbody><colgroup><col><col><col span="3"><col><col span="3"><col><col span="3"><col><col span="3"><col><col><col><col><col><col><col><col></colgroup>
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
I can suggest VB code to achieve your result. If you need only formula to solve your problem, I have no idea. Probably some other expert may help you with formula.
 
Upvote 0
Try this:
Code:
Private Sub cmdHorizontalIntoVertical_Click()
 Dim WayNam As String
 Dim FilNam As String
 Dim SheetNam As String
 Dim LastRecNum As Long
 
 WayNam = InputBox("Type the path name of the" & vbCrLf & _
  "Excel Source File:", "Path of your File!", "D\") 'make sure \ is typed
 FilNam = InputBox("Type the name of the" & vbCrLf & _
  "Excel Source File:", "Your File's Name!", "HorizontalDataToVertical.xlsx") 'Type with extension
 SheetNam = InputBox("Type the name of the" & vbCrLf & _
 "the Sheet in the Source File: ", "Your Sheet's Name!", "DestPage")
 Workbooks.Open Filename:=WayNam & FilNam
 Sheets(SheetNam).Select
 LastRecNum = Cells(Rows.Count, "A").End(xlUp).Row 'to go to last data cell inspite of blank cells
 MsgBox "lastrec=" & LastRecNum


 Dim NowRec As Long
 Dim SourceCol As Integer
 Dim SourceRow As Long
 Dim DestinationCol As Integer
 Dim DestinationRow As Long
 Dim NowRow As Long
 Dim CurRec As Long
 Dim BgnCol As Integer
 Dim DataRow As Integer
 NowRec = 4
 SourceCol = 1
 SourceRow = 4
 DestinationCol = 18
 
 Dim MyMonth As String
 Dim MyProductArea(1, 6) As String
 
 Dim i As Integer, j As Integer, k As Integer
 i = 1
 DestinationRow = 4
 Do While DestinationRow < LastRecNum
 
 For i = 1 To 3
  DataRow = 4
  If i = 1 Then
   MyMonth = "Jan"
   BgnCol = 3
   DestinationRow = 3
  ElseIf i = 2 Then
   MyMonth = "Feb"
   BgnCol = 4
  ElseIf i = 3 Then
   MyMonth = "Mar"
   BgnCol = 5
  End If 'i = 1
  If i = 1 Then
   Cells(DestinationRow - 1, 19).Value = "Product"
   Cells(DestinationRow - 1, 20).Value = "Area"
   Cells(DestinationRow - 1, 21).Value = "Month"
   Cells(DestinationRow - 1, 22).Value = "Volume"
   Cells(DestinationRow - 1, 23).Value = "Sales"
   Cells(DestinationRow - 1, 24).Value = "Cost"
   Cells(DestinationRow - 1, 25).Value = "Profit"


   For SourceCol = 1 To 2
    For NowRow = 0 To 6
     SourceRow = NowRow + 4
     MyProductArea(SourceCol - 1, NowRow) = Cells(SourceRow, SourceCol)
     'while source col is 0 myproductarea = A, B, C, E, D, A, A
     'while source col is 1 myproductarea = BLACK, BLACK, RED, GREEN, GREEN, BLUE, GREEN
    Next 'nowRow = 0 To 6
   Next 'SourceCol = 1 To 2
  End If ' i = 1
  For NowRow = 0 To 6
   DestinationRow = DestinationRow + 1
   SourceCol = 0
    For DestinationCol = 19 To 20
     SourceCol = SourceCol + 1
     Cells(DestinationRow, DestinationCol).Value = MyProductArea(SourceCol - 1, NowRow)
    Next 'DestinationCol = 19 to 25
    Cells(DestinationRow, DestinationCol).Value = MyMonth
    For SourceCol = BgnCol To 17 Step 4
     DestinationCol = DestinationCol + 1
     Cells(DestinationRow, DestinationCol).Value = Cells(DataRow, SourceCol).Value
    Next 'SourceCol = 3 To 17 Step 4
    DataRow = DataRow + 1
  Next 'nowRow = 0 To 6
 Next 'i = 1 to 3
 If i = 3 Then
  Exit Do
 End If
 Loop 'CurRec < LastRecNum
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,501
Messages
6,114,010
Members
448,543
Latest member
MartinLarkin

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
Back
Top