Translate Horizontal Data Set Into a Verical One

S

seancgn68

New Member
Joined
Jan 20, 2017
Messages
5
I have a database which I have to enter about 5K line items in a specific format. I am not sure how to translate my raw data into the acceptable format. I have only moderate Excel skills, and know little about macros/VBA. Any help is greatly appreciated!

Current format:
[TABLE="width: 300"]
<tbody>[TR]
[TD="width: 98, bgcolor: transparent"]Customer/Fcst
[/TD]
[TD="width: 74, bgcolor: transparent"]Jan-16
[/TD]
[TD="width: 74, bgcolor: transparent"]Feb-16
[/TD]
[TD="width: 74, bgcolor: transparent"]Mar-16
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]27,000
[/TD]
[TD="bgcolor: transparent"]28,500
[/TD]
[TD="bgcolor: transparent"]33,789
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]XXX
[/TD]
[TD="bgcolor: transparent"]48,000
[/TD]
[TD="bgcolor: transparent"]49,789
[/TD]
[TD="bgcolor: transparent"]47,125
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]CBA
[/TD]
[TD="bgcolor: transparent"]2,000
[/TD]
[TD="bgcolor: transparent"]2,478
[/TD]
[TD="bgcolor: transparent"]2,698
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]RST
[/TD]
[TD="bgcolor: transparent"]78,045
[/TD]
[TD="bgcolor: transparent"]79,045
[/TD]
[TD="bgcolor: transparent"]77,456
[/TD]
[/TR]
</tbody>[/TABLE]

Needed Format:

[TABLE="width: 220"]
<tbody>[TR]
[TD="width: 98, bgcolor: transparent"]Customer
[/TD]
[TD="width: 74, bgcolor: transparent"]Month
[/TD]
[TD="width: 74, bgcolor: transparent"]Fcst
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]Jan-16
[/TD]
[TD="bgcolor: transparent"]27,000
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]XXX
[/TD]
[TD="bgcolor: transparent"]Jan-16
[/TD]
[TD="bgcolor: transparent"]48,000
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]CBA
[/TD]
[TD="bgcolor: transparent"]Jan-16
[/TD]
[TD="bgcolor: transparent"]2,000
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]RST
[/TD]
[TD="bgcolor: transparent"]Jan-16
[/TD]
[TD="bgcolor: transparent"]78,045
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]Feb-16
[/TD]
[TD="bgcolor: transparent"]28,500
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]XXX
[/TD]
[TD="bgcolor: transparent"]Feb-16
[/TD]
[TD="bgcolor: transparent"]49,789
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]CBA
[/TD]
[TD="bgcolor: transparent"]Feb-16
[/TD]
[TD="bgcolor: transparent"]2,478
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]RST
[/TD]
[TD="bgcolor: transparent"]Feb-16
[/TD]
[TD="bgcolor: transparent"]79,045
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]Mar-16
[/TD]
[TD="bgcolor: transparent"]33,789
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]XXX
[/TD]
[TD="bgcolor: transparent"]Mar-16
[/TD]
[TD="bgcolor: transparent"]47,125
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]CBA
[/TD]
[TD="bgcolor: transparent"]Mar-16
[/TD]
[TD="bgcolor: transparent"]2,698
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]RST
[/TD]
[TD="bgcolor: transparent"]Mar-16
[/TD]
[TD="bgcolor: transparent"]77,456
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Welcome to the Board!

Here is some VBA code that should do what you need. You should only really have need to change the settings in the rows between the asterisks.
Code: 
Sub CopyData()

    Dim srcSht As Worksheet
    Dim dstSht As Worksheet
    Dim startRow As Long
    Dim startCol As Long
    Dim endRow As Long
    Dim endCol As Long
    Dim myRow As Long
    Dim myCol As Long
    Dim myCust As String
    Dim myDate As Date
    Dim rowCounter As Long

'******************************************************************
        
'   Set source and destination sheets
    Set srcSht = Sheets("Sheet3")
    Set dstSht = Sheets("Sheet4")
    
'   Set starting row of your data range (include header)
    startRow = 1
'   Set starting column of your data range
    startCol = 1
    
'******************************************************************
    
    Application.ScreenUpdating = False

'   Find last row with data on source sheet
    endRow = srcSht.Cells(startRow, startCol).End(xlDown).Row
'   Find last column with data on source sheet
    endCol = srcSht.Cells(startRow, startCol).End(xlToRight).Column
    
'   Set headers on destination sheet
    dstSht.Range("A1") = "Customer"
    dstSht.Range("B1") = "Month"
    dstSht.Range("C1") = "Fcst"
    
'   Format column B on source sheet
    dstSht.Columns("B:B").NumberFormat = "yy-mmm"
    
'   Set starting row number on destination sheet (header in row 1, so data starts in 2)
    rowCounter = 2
    
'   Loop through all data
    For myRow = startRow + 1 To endRow
        For myCol = startCol + 1 To endCol
            dstSht.Cells(rowCounter, "A") = srcSht.Cells(myRow, startCol)
            dstSht.Cells(rowCounter, "B") = srcSht.Cells(startRow, myCol)
            dstSht.Cells(rowCounter, "C") = srcSht.Cells(myRow, myCol)
            rowCounter = rowCounter + 1
        Next myCol
    Next myRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro Complete!"
    
End Sub
 
Upvote 0
You are welcome!

I tried to document some of the code, so you can see what is going on. Hope it makes sense!
 
Upvote 0
Thanks, this worked great! One more question, if I wanted to add a couple of more "description" columns to my raw data linked to "Customer" that would carry over too, how would I modify the code?

[TABLE="width: 500"]
<tbody>[TR]
[TD="width: 67, bgcolor: transparent"]Customer
[/TD]
[TD="width: 85, bgcolor: transparent"]City
[/TD]
[TD="width: 39, bgcolor: transparent"]State
[/TD]
[TD="width: 74, bgcolor: transparent, align: right"]
16-Jan​
[/TD]
[TD="width: 74, bgcolor: transparent, align: right"]
16-Feb​
[/TD]
[TD="width: 74, bgcolor: transparent, align: right"]
16-Mar​
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]San Diego
[/TD]
[TD="bgcolor: transparent"]CA
[/TD]
[TD="bgcolor: transparent"]27,000
[/TD]
[TD="bgcolor: transparent"]28,500
[/TD]
[TD="bgcolor: transparent"]33,789
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABC
[/TD]
[TD="bgcolor: transparent"]Houston
[/TD]
[TD="bgcolor: transparent"]TX
[/TD]
[TD="bgcolor: transparent"]1,542
[/TD]
[TD="bgcolor: transparent"]5,465
[/TD]
[TD="bgcolor: transparent"]1,245
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]XXX
[/TD]
[TD="bgcolor: transparent"]Philadelphia
[/TD]
[TD="bgcolor: transparent"]PA
[/TD]
[TD="bgcolor: transparent"]48,000
[/TD]
[TD="bgcolor: transparent"]49,789
[/TD]
[TD="bgcolor: transparent"]47,125
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]CBA
[/TD]
[TD="bgcolor: transparent"]Tampa Bay
[/TD]
[TD="bgcolor: transparent"]FL
[/TD]
[TD="bgcolor: transparent"]2,000
[/TD]
[TD="bgcolor: transparent"]2,478
[/TD]
[TD="bgcolor: transparent"]2,698
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]RST
[/TD]
[TD="bgcolor: transparent"]Pittsburg
[/TD]
[TD="bgcolor: transparent"]PA
[/TD]
[TD="bgcolor: transparent"]78,045
[/TD]
[TD="bgcolor: transparent"]79,045
[/TD]
[TD="bgcolor: transparent"]77,456
[/TD]
[/TR]
</tbody>[/TABLE]

Sorry I am not too familiar with VBA coding, and want to make sure I can modify as needed. Thanks!

Joe4 said:
Welcome to the Board!

Here is some VBA code that should do what you need. You should only really have need to change the settings in the rows between the asterisks.
Code: 
Sub CopyData()

    Dim srcSht As Worksheet
    Dim dstSht As Worksheet
    Dim startRow As Long
    Dim startCol As Long
    Dim endRow As Long
    Dim endCol As Long
    Dim myRow As Long
    Dim myCol As Long
    Dim myCust As String
    Dim myDate As Date
    Dim rowCounter As Long

'******************************************************************
        
'   Set source and destination sheets
    Set srcSht = Sheets("Sheet3")
    Set dstSht = Sheets("Sheet4")
    
'   Set starting row of your data range (include header)
    startRow = 1
'   Set starting column of your data range
    startCol = 1
    
'******************************************************************
    
    Application.ScreenUpdating = False

'   Find last row with data on source sheet
    endRow = srcSht.Cells(startRow, startCol).End(xlDown).Row
'   Find last column with data on source sheet
    endCol = srcSht.Cells(startRow, startCol).End(xlToRight).Column
    
'   Set headers on destination sheet
    dstSht.Range("A1") = "Customer"
    dstSht.Range("B1") = "Month"
    dstSht.Range("C1") = "Fcst"
    
'   Format column B on source sheet
    dstSht.Columns("B:B").NumberFormat = "yy-mmm"
    
'   Set starting row number on destination sheet (header in row 1, so data starts in 2)
    rowCounter = 2
    
'   Loop through all data
    For myRow = startRow + 1 To endRow
        For myCol = startCol + 1 To endCol
            dstSht.Cells(rowCounter, "A") = srcSht.Cells(myRow, startCol)
            dstSht.Cells(rowCounter, "B") = srcSht.Cells(startRow, myCol)
            dstSht.Cells(rowCounter, "C") = srcSht.Cells(myRow, myCol)
            rowCounter = rowCounter + 1
        Next myCol
    Next myRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro Complete!"
    
End Sub
Click to expand...
 
Upvote 0
And what would the new format need to look like in that case?
 
Upvote 0
I figured it out. I took a closer look at your code, and the documentation you put in there were very helpful. Thanks again for your assistance!
Click to expand...
Well done!
I always like it when people look to learn it, and aren't just looking for answers!
:beerchug:
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Translating a horizontal data set to a pivot table friendly vertical format
Replies
6
Views
2K
TaxSloth
T

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

Share this page

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