• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

excel VBA code to reformat data

vaida

New Member
Hello, can anyone help me with macro code which could reformat my data. what i want to do is per below.
Also i would like to have an option to expand the columns with time.

current formal:
Volume Price
group1 group2 group3 01.2015 02.2015 03.2015 01.2015 02.2015 03.2015
aaa aaa aaa 10 15 16 100 121 120
bbb bbb bbb 5 8 10 80 101 90


wanted format:

month/year group1 group2 group3 Volume Price
01.2015 aaa aaa aaa 10 100
01.2015 bbb bbb bbb 5 80
02.2015 aaa aaa aaa 15 121
02.2015 bbb bbb bbb 8 101
03.2015 aaa aaa aaa 16 120
03.2015 bbb bbb bbb 10 90
 

Attachments

  • Untitled.jpg
    Untitled.jpg
    113.8 KB · Views: 11
  • sample.xlsx
    9.2 KB · Views: 2
Last edited:
Hi vaida, and welcome to the forum! :awesome:

Please give this workbook a look. Make sure you look over the code and understand how to setup initial boundaries. Code is dynamic to handle growing number of Volume and Price columns (does assume that there are equal number of Price and Volumn columns...)
 

Attachments

  • Transfer LM.xlsm
    16.7 KB · Views: 5
This also flexible to the number of columns before "Volume" column as long as you have "Volume" & "Price" heading in row 1.
Code:
Sub test()
    Dim a, b, x, i As Long, ii As Long, iii As Long, n As Long
    With Sheets("sheet1").Cells(1).CurrentRegion
        a = .Value
        x = Application.Match(Array("Volume", "Price"), .Rows(1), 0)
        ReDim b(1 To .Rows.Count * .Columns.Count, 1 To x(1) + 2)
        b(1, 1) = "month/year": b(1, UBound(b, 2)) = "Price"
        b(1, UBound(b, 2) - 1) = "Volume": n = 1
    End With
    For ii = 2 To x(1)
        b(1, ii) = a(2, ii - 1)
    Next
    For ii = x(1) To x(2) - 1
        For i = 3 To UBound(a, 1)
            n = n + 1: b(n, 1) = "'" & a(2, ii)
            For iii = 2 To x(1)
                b(n, iii) = a(i, iii - 1)
            Next
            b(n, UBound(b, 2) - 1) = a(i, ii)
            b(n, UBound(b, 2)) = a(i, ii + x(2) - x(1))
        Next
    Next
    Sheets.Add.Cells(1).Resize(n, UBound(b, 2)).Value = b
End Sub
 

Attachments

  • sample with code.xlsm
    17.9 KB · Views: 5
Thanks you for the code it works well!!!!!!

I prefer the last ones flexibility to grab multiple groups as i might add much more in future.

dear jindon, could you help me with few small adjustments:
  1. would like to add extra columns "Volume" "Price" "Forecast" "Demand" maybe some more if needed in future. How can I adjust the code to grab more data?
  2. one destination sheet for output where data would be refreshed instead of getting new sheet every time I run the code.
  3. Can my first row be row 3?
"This also flexible to the number of columns before "Volume" column as long as you have "Volume" & "Price" heading in row 1." How can i make it to be 3 row?

Thank you in advance for the help :DD:DD:DD:):):)
 
Last edited:
You MUST have;
1) 1st header in row 3 and 2nd header in row 4 starts from A4
2) 2nd row blank
3) prepare sheet named "Result"
Code:
Sub test()
    Dim a, b, x, i As Long, ii As Long, iii As Long, n As Long, iv, t As Long
    With Sheets("sheet1").Range("a3").CurrentRegion
        a = .Value
        x = Filter(.Parent.Evaluate("if(" & .Rows(1).Address & "<>"""",column(" & _
            .Rows(1).Address & "),char(2))"), Chr(2), 0)
        ReDim b(1 To .Rows.Count * .Columns.Count, 1 To x(0) + UBound(x) + 1)
    End With
    b(1, 1) = "month/year": n = 1
    For ii = 2 To x(0): b(1, ii) = a(2, ii - 1): Next
    For ii = 0 To UBound(x): b(1, x(0) + ii + 1) = a(1, x(ii)): Next
    For ii = x(0) To x(1) - 1
        t = t + 1: If t > x(1) - x(0) Then t = 1
        For i = 3 To UBound(a, 1)
            n = n + 1: b(n, 1) = "'" & a(2, ii)
            For iii = 2 To x(0)
                b(n, iii) = a(i, iii - 1)
            Next
            For iii = 0 To UBound(x)
                b(n, x(0) + iii + 1) = a(i, Val(x(iii)) + t - 1)
            Next
        Next
    Next
    With Sheets("result").Cells(1).Resize(n, UBound(b, 2))
        .CurrentRegion.ClearContents
        .Value = b
        .Columns.AutoFit: .Parent.Select
    End With
End Sub
 
Back
Top