Bob
Bob

Reputation: 885

Convert Row into Column

I have the following data in excel:-

enter image description here

I need to convert them into row & the final result should be as follows:-

enter image description here

How can I do it in excel?

Upvotes: 0

Views: 159

Answers (1)

Dy.Lee
Dy.Lee

Reputation: 7567

This code New sheet add and out the result.

Sub test()
    Dim vDB, vR()
    Dim Ws As Worksheet
    Dim r As Long, c As Long
    Dim i As Long, n As Long, j As Integer
    Set Ws = ActiveSheet

    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        'vDB = .Range("a1", .Cells(r, c))
        vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row)
    End With

    For i = 2 To UBound(vDB, 1) Step 4
        For j = 4 To UBound(vDB, 2)
            n = n + 1
            ReDim Preserve vR(1 To 7, 1 To n)
            vR(1, n) = vDB(i, 1)
            vR(2, n) = vDB(i, 2)
            vR(3, n) = vDB(i, j)
            vR(4, n) = vDB(i + 1, j)
            vR(5, n) = vDB(i + 2, j)
            vR(6, n) = vDB(i + 3, j)
            vR(7, n) = vDB(1, j)
        Next j
    Next i
    Sheets.Add
    Range("a1").Resize(1, 7) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Daily Opex", "Date")
    Range("a2").Resize(n, 7) = WorksheetFunction.Transpose(vR)


End Sub

Case of including Support

Sub test()
    Dim vDB, vR()
    Dim Ws As Worksheet
    Dim r As Long, c As Long
    Dim i As Long, n As Long, j As Integer
    Set Ws = ActiveSheet

    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        'vDB = .Range("a1", .Cells(r, c))
        vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row)
    End With

    For i = 2 To UBound(vDB, 1) Step 5
        For j = 4 To UBound(vDB, 2)
            n = n + 1
            ReDim Preserve vR(1 To 8, 1 To n)
            vR(1, n) = vDB(i, 1)
            vR(2, n) = vDB(i, 2)
            vR(3, n) = vDB(i, j)
            vR(4, n) = vDB(i + 1, j)
            vR(5, n) = vDB(i + 2, j)
            vR(6, n) = vDB(i + 3, j)
            vR(7, n) = vDB(i + 4, j)
            vR(8, n) = vDB(1, j)
        Next j
    Next i
    Sheets.Add
    Range("a1").Resize(1, 8) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Support", "Daily Opex", "Date")
    Range("a2").Resize(n, 8) = WorksheetFunction.Transpose(vR)


End Sub

Upvotes: 3

Related Questions