Macro to Transpose Data

[hftechno]

Looking for a macro that will transpose my data. See attached example.

*As multiple items will be transposed. Date and Month are important, the actual day is not.


Capture.JPG


Thanks so much in advance.

[JLGWhiz]

Using your uploaded file, this seemed to work.

Sub t()
Dim c As Range, fn As Range, i As Long
    With Sheets("Sheet1")
        For Each c In .Range("G2", .Cells(Rows.Count, 7).End(xlUp))
            Set fn = Sheets("Result").Range("C2", Sheets("Result").Cells(Rows.Count, 3).End(xlUp)).Find(c.Offset(, -4).Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    With Sheets("Result")
                        For i = 6 To .Cells(1, Columns.Count).End(xlToLeft).Column
                        'MsgBox Month(.Cells(1, i).Value) & vbLf & Month(c.Offset(, -1).Value)
                            If Month(.Cells(1, i).Value) = Month(c.Offset(, -1).Value) And _
                            Year(.Cells(1, i).Value) = Year(c.Offset(, -1).Value) Then
                                .Cells(fn.Row, i) = c.Value
                            End If
                        Next
                    End With
                End If
        Next
    End With
End Sub

[hftechno]

JLGWhiz - thanks for the quick reply.
I messed up my example and am going to I will mark this as completed & repost the question.


Moderator Comment: Do not duplicate a thread. Continue in the original thread with the changes. I have merged the two threads.

[hftechno]

Looking for a macro that will transpose my monthly data onto a new sheet.

*As multiple items will be transposed. Date and Month are important, the actual day is not.

Thanks so much in advance.



Capture4.JPG

[vba_php]

that's probably advanced. lots of work. post in the commercial services section perhaps? there is a built-in function called transpose, however it will not give you want you. only partially. maybe try it and see? see if it gives you something close to what you want, and then ask for the last little bit? that's an idea.

[AliGW]

There is absolutely no need for the OP to pay for a solution in Commercial Services. This can be done easily with Power Query, and there will be formula solutions, too. It’s not a lot of work.

I will share a PQ solution tomorrow if nobody else gets in first.

[vba_php]

I had no idea. thanks for saying. you're the PQ expert, not me.

[AliGW]

I had no idea. thanks for saying. you're the PQ expert, not me.

If you don't know whether something can be done or not, it's best not to respond to the thread, as I have advised you before. By doing so, you remove the thread from the unanswered threads list for no good reason: speculation doesn't get the OP any further forward. Please try not to do this. Thanks.

[alansidman]

As Ali indicated. A fairly simple task for Power Query. Mcode:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Customer Location.", Int64.Type}, {"Plant Desc.", type text}, {"Product", Int64.Type}, {"Prod.Desc.", type text}, {"Unit of Measure", type text}, {"Deliv. Date", type date}, {"Document Qty.", Int64.Type}}),
    #"Inserted Start of Month" = Table.AddColumn(#"Changed Type", "Start of Month", each Date.StartOfMonth([Deliv. Date]), type date),
    #"Removed Columns" = Table.RemoveColumns(#"Inserted Start of Month",{"Deliv. Date"}),
    #"Pivoted Column" = Table.Pivot(Table.TransformColumnTypes(#"Removed Columns", {{"Start of Month", type text}}, "en-US"), List.Distinct(Table.TransformColumnTypes(#"Removed Columns", {{"Start of Month", type text}}, "en-US")[#"Start of Month"]), "Start of Month", "Document Qty.")
in
    #"Pivoted Column"

Excel 2016 (Windows) 32 bit

	A	B	C	D	E	F	G	H	I	J	K
1	Customer Location.	Plant Desc.	Product	Prod.Desc.	Unit of Measure	12/1/2020	1/1/2020	2/1/2020	6/1/2021	1/1/2021	2/1/2021
2	11111	Customer - 1	1075176	Product Description	KG				50
3	11111	Customer - 1	10046903	Product Description	KG	50	534	890
4	22222	Customer - 2	10045134	Product Description	KG				174	1234	806
5	22222	Customer - 2	10049999	Product Description	KG		25

Sheet: Table1

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

[jindon]

hftechno

Didn't you ask similar question?

VBA

Sub test()
    Dim a, x, i As Long, ii As Long, txt As String, AL As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To 50)
    For ii = 1 To 5: b(1, ii) = a(1, ii): Next
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            a(i, 6) = a(i, 6) - Day(a(i, 6)) + 1
            If Not AL.Contains(a(i, 6)) Then AL.Add a(i, 6)
            txt = Join(Array(a(i, 1), a(i, 2), a(i, 3), _
                        a(i, 4), a(i, 5)), Chr(2))
            If Not .exists(txt) Then
                Set .Item(txt) = CreateObject("Scripting.Dictionary")
            End If
            .Item(txt)(a(i, 6)) = .Item(txt)(a(i, 6)) + a(i, 7)
        Next
        AL.Sort
        ReDim Preserve a(1 To UBound(a, 1), 1 To 5)
        ReDim Preserve a(1 To UBound(a, 1), 1 To AL.Count + 5)
        For ii = 0 To AL.Count - 1: a(1, ii + 6) = AL(ii): Next
        For i = 0 To .Count - 1
            x = Split(.keys()(i), Chr(2))
            For ii = 0 To UBound(x)
                a(i + 2, ii + 1) = x(ii)
            Next
            For ii = 0 To .items()(i).Count - 1
                a(i + 2, AL.IndexOf_3(.items()(i).keys()(ii)) + 6) = .items()(i).items()(ii)
            Next
        Next
        i = .Count + 1
    End With
    With Sheets.Add.Cells(1).Resize(i, AL.Count + 5)
        .Value = a
        .HorizontalAlignment = xlCenter
        .Columns("f").Resize(, AL.Count).NumberFormat = "#,##0.00"
        .Columns.AutoFit
    End With
End Sub

[vba_php]

sure thing.

[hftechno]

This is the best forum

- AliGW you are hilarious! Thanks for keeping law and order.
- alansidman , thanks so much for all of the detail. I have never used Power Query before ...but will definitely do so now. Your solution worked!
- jindon, your answer worked as well, thanks as always.

I chose jindon's because it is a ready made macro.

[AliGW]

We aim to please.

[JLGWhiz]

@hitechno - Thanks for the reps. The code I posted also works on the revised sheets.
Regards, JLG

[alansidman]

Also, thank you for the reps.