change data from Horizontal to vertical format

[Rajeev Shah]

Hi All,

I have data in horizontal format and need to change same into vertical format.

Please see example below.

I would like to keep the columns " Car" & "Make" intact but change " Jan Sales" , " feb sales" & " Mar Sales" into rows. ( vertical format )

is there a macro or formula for same ?

CarMakeJan SalesFeb SalesMar sales
HondaSedan200032001500
ToyotaSUV160019003400
NissanhatchBack210018001900
HyundaiVan320025001700

Thanks,
Rajeev

 

[AlanSidman]

Upload a sample worksheet. This requires some VBA coding and it will be better done with an actual worksheet. Limit the amount of data in the worksheet, but be sure it is a representative sample.

 

[Rajeev Shah]

Hi Alan,

Please see attached file. I have indicated which columns need to remain intact and which need to be converted vertical.

Thanks for your help.

Rajeev

 

[bosco_yip]

Here's a formula way.

1] In H3, formula copy across to J3 and all copy down :

=IFERROR(INDEX(A$3:A$18,INT((ROWS($1:1)-1)/3)+1),"")

2] In K3, formula copy down :

=IF(J3="","",INDEX($D$2:$F$2,MOD(ROWS($1:1)-1,3)+1))

3] In L3, formula copy down :

=IF(J3="","",INDEX($D$3:$F$18,MATCH($J3,$C$3:$C$18,0),MATCH($K3,$D$2:$F$2,0)))

Regards
Bosco

 

[SirJB7]

Hi, Rajeev Shah!
I don't fully understand your requirement. Would you please upload again the sample file, indicating manually how do you want the output?
Regards!

Edited: If it's like bosco_yip posted, then discard this message.

 

[AlanSidman]

Here is a VBA solution.

Option Explicit

Sub trans()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr As Long, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long
    Application.ScreenUpdating = False
    With s1
        .Range("A2:C2").Copy s2.Range("A1")
        s2.Range("D1") = "Forecast"
        For i = 3 To lr
            lr2 = s2.Range("D" & Rows.Count).End(xlUp).Row
            .Range("A" & i & ":C" & i).Copy s2.Range("A" & lr2 + 1)
            .Range("D2:F2").Copy
            s2.Range("D" & lr2 + 1).PasteSpecial xlPasteAll, , , True
            .Range("D" & i & ":F" & i).Copy
            s2.Range("E" & lr2 + 1).PasteSpecial xlPasteValues, , , True
        Next i
    End With
    Application.CutCopyMode = False
    lr2 = s2.Range("D" & Rows.Count).End(xlUp).Row
    For i = 3 To lr2
        If s2.Range("A" & i) = "" Then
            s2.Range("A" & i) = s2.Range("A" & i - 1)
            s2.Range("B" & i) = s2.Range("B" & i - 1)
            s2.Range("C" & i) = s2.Range("C" & i - 1)
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Job completed"

End Sub

 

[Rajeev Shah]

Thanks all. I will check out the formula as well as Macro. Appreciate help on this.

Rajeev

 

[Devender Kumar Yadav]

Long way of the same

Please find the attachement

 

[Rajeev Shah]

Here's a formula way.

1] In H3, formula copy across to J3 and all copy down :

=IFERROR(INDEX(A$3:A$18,INT((ROWS($1:1)-1)/3)+1),"")

2] In K3, formula copy down :

=IF(J3="","",INDEX($D$2:$F$2,MOD(ROWS($1:1)-1,3)+1))

3] In L3, formula copy down :

=IF(J3="","",INDEX($D$3:$F$18,MATCH($J3,$C$3:$C$18,0),MATCH($K3,$D$2:$F$2,0)))

Regards
Bosco

Here's a formula way.

1] In H3, formula copy across to J3 and all copy down :

=IFERROR(INDEX(A$3:A$18,INT((ROWS($1:1)-1)/3)+1),"")

2] In K3, formula copy down :

=IF(J3="","",INDEX($D$2:$F$2,MOD(ROWS($1:1)-1,3)+1))

3] In L3, formula copy down :

=IF(J3="","",INDEX($D$3:$F$18,MATCH($J3,$C$3:$C$18,0),MATCH($K3,$D$2:$F$2,0)))

Regards
Bosco

-------------------------------------------------------------------------

Thanks Bosco. It works great.