Convert Horizontal data to vertical data

Laurens19995

New Member
Joined
Apr 12, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi everyone,

I already did a lot of research on finding a correct macro or other way to transfer data from horizontal to vertical, whilst in some columns I want to have the same records. And the records should stay the same until the whole row is converted to vertical. And I would also like to skip the empty cells.

Example:
OrdernumberLOADINGUNLOADINGPalletsParcelsKg'sCode transportCost transportCode fuelCost fuelCode time deliveryTime delivery costsAdditional code costsAdditional costsExtra cost codeExtra costs
61053744​
AmazonWalmart
1​
0​
1826,634​
FR1€ 100,00FR3€ 41,65FR5€ 50,00AA100€ 75,00AA101€ 10,00
61054012​
AmazonTiffany
3​
0​
515,52​
FR19€ 100,00FR20€ 38,83AA102€ 75,50
61053947​
AmazonWalmart
0​
3​
458,832​
FR2€ 100,00FR3€ 38,58AA104€ 50,00AA105€ 75,50AA106€ 10,00


Then I would like to have in converted like this:
OrdernumberLOADINGUNLOADINGPalletsParcelsKg'sCodeCosts
61053744​
AmazonWalmart
1​
1826,634​
FR1$ 100,00
61053744​
AmazonWalmartFR3$ 41,65
61053744​
AmazonWalmartFR5$ 50,00
61053744​
AmazonWalmartAA100$ 75,00
61053744​
AmazonWalmartAA101$ 10,00
61054012​
AmazonTiffany
3​
515,52​
FR19$ 100,00
61054012​
AmazonTiffanyFR20$ 38,83
61054012​
AmazonTiffanyAA102$ 75,50
61053947​
AmazonWalmart
3​
458,832​
FR2$ 100,00
61053947​
AmazonWalmartFR3$ 38,58
61053947​
AmazonWalmartAA104$ 50,00
61053947​
AmazonWalmartAA105$ 75,50
61053947​
AmazonWalmartAA106$ 10,00

So basically column A-C should be repeated until all data in the column codes has been filled from the same order number. And the number of pallets, parcels and kg's repeated once.


Hopefully this is possible!


Many thanks for your support already!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Welcome to the forum!

Try running this on a copy of your worksheet. A new sheet would be added.
VBA Code:
Sub ME1167836_Split()
    Dim i As Long, j As Long, k As Long, c As Long
    Dim a, b(), h
    
    With ActiveSheet
        With .UsedRange.Offset(1)
            With .Resize(.Rows.Count - 1)
                a = .Value
                c = Application.CountA(.Columns(7)) 'column G (code transport)
                c = c + Application.CountA(.Columns(9)) 'column I (code fuel)
                c = c + Application.CountA(.Columns(11)) 'column K (code time delivery)
                c = c + Application.CountA(.Columns(13)) 'column M (Additional code costs)
                c = c + Application.CountA(.Columns(15)) 'column O (Extra cost code)
            End With
        End With
        
        ReDim b(1 To UBound(a, 1) + c, 1 To 8)
        c = 1
        For i = 1 To UBound(a, 1)
            For j = 1 To 8
                b(c, j) = a(i, j)
            Next
            For j = 7 To UBound(a, 2) Step 2
                If a(i, j) <> "" Then
                    c = c + 1
                    For k = 1 To 3
                        b(c, k) = a(i, k)
                    Next
                    b(c, 7) = a(i, j)
                    b(c, 8) = a(i, j + 1)
                End If
            Next
            c = c + 1
        Next
        
        h = .Range("a1:f1").Value
        With Sheets.Add
            .Range("a1").Resize(, 6).Value = h
            .Range("g1:h1").Value = Array("Code", "Costs")
            .Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
            .Columns.AutoFit
        End With
    End With
End Sub
 
Upvote 0
Welcome to the forum!

Try running this on a copy of your worksheet. A new sheet would be added.
VBA Code:
Sub ME1167836_Split()
    Dim i As Long, j As Long, k As Long, c As Long
    Dim a, b(), h
   
    With ActiveSheet
        With .UsedRange.Offset(1)
            With .Resize(.Rows.Count - 1)
                a = .Value
                c = Application.CountA(.Columns(7)) 'column G (code transport)
                c = c + Application.CountA(.Columns(9)) 'column I (code fuel)
                c = c + Application.CountA(.Columns(11)) 'column K (code time delivery)
                c = c + Application.CountA(.Columns(13)) 'column M (Additional code costs)
                c = c + Application.CountA(.Columns(15)) 'column O (Extra cost code)
            End With
        End With
       
        ReDim b(1 To UBound(a, 1) + c, 1 To 8)
        c = 1
        For i = 1 To UBound(a, 1)
            For j = 1 To 8
                b(c, j) = a(i, j)
            Next
            For j = 7 To UBound(a, 2) Step 2
                If a(i, j) <> "" Then
                    c = c + 1
                    For k = 1 To 3
                        b(c, k) = a(i, k)
                    Next
                    b(c, 7) = a(i, j)
                    b(c, 8) = a(i, j + 1)
                End If
            Next
            c = c + 1
        Next
       
        h = .Range("a1:f1").Value
        With Sheets.Add
            .Range("a1").Resize(, 6).Value = h
            .Range("g1:h1").Value = Array("Code", "Costs")
            .Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
            .Columns.AutoFit
        End With
    End With
End Sub

it's almost perfect, but for the first code I get a double record. Can you have a look at that? I am already very happy with the fast reply you could give me!
OrdernumberLOADINGUNLOADINGPalletsParcelsKg'sCodeCosts
61053744​
AmazonWalmart
1​
0​
1826,634​
FR1
100​
61053744​
AmazonWalmartFR1
100
61053744​
AmazonWalmartFR3
41,64669813​
61053744​
AmazonWalmartFR5
50​
61053744​
AmazonWalmartAA100
75​
61053744​
AmazonWalmartAA101
10​
61054012​
AmazonTiffany
3​
0​
515,52​
FR19
100​
61054012​
AmazonTiffanyFR19
100
61054012​
AmazonTiffanyFR20
38,82905​
61054012​
AmazonTiffanyAA102
75,5​
61053947​
AmazonWalmart
0​
3​
458,832​
FR2
100​
61053947​
AmazonWalmartFR2
100
61053947​
AmazonWalmartFR3
38,581205​
61053947​
AmazonWalmartAA104
50​
61053947​
AmazonWalmartAA105
75,5​
61053947​
AmazonWalmartAA106
10​
 
Upvote 0
Apologies for that, try amending this line "7"
VBA Code:
            For j = 7 To UBound(a, 2) Step 2
to "9":
VBA Code:
            For j = 9 To UBound(a, 2) Step 2


Edit: this assumes column G always has a code, if this is not the case then I will have to amend the code further.
 
Upvote 0
Apologies for that, try amending this line "7"
VBA Code:
            For j = 7 To UBound(a, 2) Step 2
to "9":
VBA Code:
            For j = 9 To UBound(a, 2) Step 2


Edit: this assumes column G always has a code, if this is not the case then I will have to amend the code further.
Great! I just saw that in the template where I need to vertical data for, we would need a column switched. Is that also possible? The desired lay-out will then be:
CodeOrdernumberLOADINGUNLOADINGPalletsParcelsKg'sCosts
FR1
61053744​
AmazonWalmart
1​
1826,634​
100​
FR3
61053744​
AmazonWalmart
41,6467​
FR5
61053744​
AmazonWalmart
50​
AA100
61053744​
AmazonWalmart
75​
AA101
61053744​
AmazonWalmart
10​
FR19
61054012​
AmazonTiffany
3​
515,52​
100​
FR20
61054012​
AmazonTiffany
38,82905​
AA102
61054012​
AmazonTiffany
75,5​
FR2
61053947​
AmazonWalmart
3​
458,832​
100​
FR3
61053947​
AmazonWalmart
38,58121​
AA104
61053947​
AmazonWalmart
50​
AA105
61053947​
AmazonWalmart
75,5​
AA106
61053947​
AmazonWalmart
10​
 
Upvote 0
Yes, rather than rearranging the code and everything, we can simply do a cut/insert.

VBA Code:
        With Sheets.Add
            .Range("a1").Resize(, 6).Value = h
            .Range("g1:h1").Value = Array("Code", "Costs")
            .Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
            .Columns(7).Cut
            .Columns(1).Insert
            .Columns.AutoFit
        End With
 
Upvote 0
Yes, rather than rearranging the code and everything, we can simply do a cut/insert.

VBA Code:
        With Sheets.Add
            .Range("a1").Resize(, 6).Value = h
            .Range("g1:h1").Value = Array("Code", "Costs")
            .Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
            .Columns(7).Cut
            .Columns(1).Insert
            .Columns.AutoFit
        End With
Awesome!! So many thanks!! And really quick as well!
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,210
Members
448,554
Latest member
Gleisner2

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