Reformat data - multiple Columns to rows

**mfusfw** · 10-31-2022, 06:08 PM

Attached is a Sample of data as it currently exists and then how it is needed to be reformatted.

Each Customer Name (Source Column A) has the potential to have data in 16 columns (Columns C:R)

I need to instead have the data be potentially 16 rows for each customer. (But then if the data in row is blank, then to not show that data).

The Outcome tab of the attached sheet would show how the layout would need to be formatted.

So for example, the First name (ALL909) has data in 6 of the 16 columns. So there should only be 6 rows of data for ALL909 when it is finalized on the Outcome tab.

**seercoven** · 10-31-2022, 10:19 PM

try this code.

Sub column_row()
    Dim ws, ws1 As Worksheet
    Dim a, b, c As Integer
 
    Set ws = Sheets("Source")
    Set ws1 = Sheets("Outcome")
    c = 2
     
    For a = 3 To 12
    For b = 3 To 18
        If ws.Cells(a, b) <> "" Then
            ws1.Cells(c, 1) = ws.Cells(i, 1)
            ws1.Cells(c, 3) = ws.Cells(2, b)
            ws1.Cells(c, 5) = ws.Cells(i, b)
            k = k + 1
        End If
        Next b
    Next i
End Sub

**mfusfw** · 11-07-2022, 04:37 PM

Originally Posted by seercoven

try this code.

Sub column_row()
    Dim ws, ws1 As Worksheet
    Dim a, b, c As Integer
 
    Set ws = Sheets("Source")
    Set ws1 = Sheets("Outcome")
    c = 2
     
    For a = 3 To 12
    For b = 3 To 18
        If ws.Cells(a, b) <> "" Then
            ws1.Cells(c, 1) = ws.Cells(i, 1)
            ws1.Cells(c, 3) = ws.Cells(2, b)
            ws1.Cells(c, 5) = ws.Cells(i, b)
            k = k + 1
        End If
        Next b
    Next i
End Sub

@Seercoven - When I try to run this code it provides an error surrounding the "Next i" command. If I try changing the "i" to an "a" it does not seem to pull through all of the needed info. Please advise.

**seercoven** · 11-07-2022, 08:19 PM

you're right. typo on my side. Please see highlighted in red changes.

Sub column_row()
    Dim ws, ws1 As Worksheet
    Dim a, b, c As Integer
 
    Set ws = Sheets("Source")
    Set ws1 = Sheets("Outcome")
    c = 2
     
    For a = 3 To 12
    For b = 3 To 18
        If ws.Cells(a, b) <> "" Then
            ws1.Cells(c, 1) = ws.Cells(i, 1)
            ws1.Cells(c, 3) = ws.Cells(2, b)
            ws1.Cells(c, 5) = ws.Cells(i, b)
            c = c + 1
        End If
        Next b
    Next a
End Sub

**mfusfw** · 11-08-2022, 01:55 PM

Originally Posted by seercoven

you're right. typo on my side.

Sub column_row()
    Dim ws, ws1 As Worksheet
    Dim a, b, c As Integer
 
    Set ws = Sheets("Source")
    Set ws1 = Sheets("Outcome")
    c = 2
     
    For a = 3 To 12
    For b = 3 To 18
        If ws.Cells(a, b) <> "" Then
            ws1.Cells(c, 1) = ws.Cells(i, 1)
            ws1.Cells(c, 3) = ws.Cells(2, b)
            ws1.Cells(c, 5) = ws.Cells(i, b)
            k = k + 1
        End If
        Next b
    Next a
End Sub

Thank you for this! Can you please explain why variables i and k do not need to be defined? Just trying to learn and grow.

When I try to run this, code it also presents an error - i think surrounding i not being defined.

**jindon** · 10-31-2022, 11:51 PM

try

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    With Sheets("source")
        a = .Range("a2", .Cells.SpecialCells(11)).Value
    End With
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 5)
    For i = 2 To UBound(a, 1)
        If a(i, 1) = "" Then Exit For
        n = n + 1: b(n, 1) = a(i, 1)
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                b(n, 3) = a(1, ii): b(n, 4) = a(1, ii) & " Descreption"
                b(n, 5) = a(i, ii): n = n + 1
            End If
        Next
        n = n - 1
    Next
    With Sheets("outcome").Cells(1).Resize(, 5)
        .EntireColumn.ClearContents
        .Value = Array("*Customer", "", "Item(Product/Service)", "ItemDescription", "*ItemAmount")
        .Rows(2).Resize(n) = b
    End With
End Sub

**mfusfw** · 11-08-2022, 03:12 PM

Originally Posted by jindon

try

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    With Sheets("source")
        a = .Range("a2", .Cells.SpecialCells(11)).Value
    End With
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 5)
    For i = 2 To UBound(a, 1)
        If a(i, 1) = "" Then Exit For
        n = n + 1: b(n, 1) = a(i, 1)
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                b(n, 3) = a(1, ii): b(n, 4) = a(1, ii) & " Descreption"
                b(n, 5) = a(i, ii): n = n + 1
            End If
        Next
        n = n - 1
    Next
    With Sheets("outcome").Cells(1).Resize(, 5)
        .EntireColumn.ClearContents
        .Value = Array("*Customer", "", "Item(Product/Service)", "ItemDescription", "*ItemAmount")
        .Rows(2).Resize(n) = b
    End With
End Sub

Jindon - This works really well and fast on the sample sheet. I was not expecting to have issues adapting the sample to what I needed to do for the live sheet. In reality the issue I am having is updating

b(n, 4) = a(1, ii) & " Descreption"

My plan was to have essentially a vlookup in this column to look up against the value in B(n,3). How would I go about adapting that. The value would be different for each value in b(n,1), so it is dependent on all of that data.

**mfusfw** · 11-30-2022, 04:25 PM

Originally Posted by jindon

try

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    With Sheets("source")
        a = .Range("a2", .Cells.SpecialCells(11)).Value
    End With
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 5)
    For i = 2 To UBound(a, 1)
        If a(i, 1) = "" Then Exit For
        n = n + 1: b(n, 1) = a(i, 1)
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                b(n, 3) = a(1, ii): b(n, 4) = a(1, ii) & " Descreption"
                b(n, 5) = a(i, ii): n = n + 1
            End If
        Next
        n = n - 1
    Next
    With Sheets("outcome").Cells(1).Resize(, 5)
        .EntireColumn.ClearContents
        .Value = Array("*Customer", "", "Item(Product/Service)", "ItemDescription", "*ItemAmount")
        .Rows(2).Resize(n) = b
    End With
End Sub

Hi Jindon,

I just ran into something that was unexpected when you originally helped, and was wondering if there is a way to help with this as well?

Attached is what the worksheet looks like with sample data - and what the Current and Desired Outcomes look like. I highlighted in Yellow where the changes occur in the two outcomes need to appear.

Essentially, if the group names are the same - but the customer names different, then something different from normal would need to happen to Column B and Column G of the data.

I did not create a new thread since this directly relates to what was being done before.

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    
    
    With Sheets("Totals")
        a = .Range("A1", .Cells.SpecialCells(11)).Value
    End With
    
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 11)
    
    For i = 2 To UBound(a, 1)
        If a(i, 1) = "" Then Exit For
            n = n + 1
            'b(n, 2) = a(i, 2)
            b(n, 2) = a(i, 2) & " - " & a(i, 1)
            'b(n, 3) = a(i, 1)
        
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                b(n, 7) = a(1, ii)
                'b(n, 8) = a(1, ii)
                b(n, 8) = a(i, 1)
                b(n, 11) = a(i, ii)
                n = n + 1
            End If
        Next
        n = n - 1
    Next
    
    With Sheets("Import").Cells(1).Resize(, 11)
        .EntireColumn.ClearContents
        .Value = Array("*InvoiceNo", "*Customer", "*InvoiceDate", "*DueDate", "Terms", "Memo", "Item (Product / Service)", "ItemDescription", "ItemQuantity", "ItemRate", "*ItemAmount")
        
        

        .Rows(2).Resize(n) = b
    End With

End Sub

**alansidman** · 11-01-2022, 01:20 AM

Unpivot your data with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Name"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"

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.

**mfusfw** · 11-02-2022, 04:10 PM

THANK YOU ALL!!!! I will play with these and let you know if I have any questions.

**jindon** · 11-08-2022, 11:59 PM

Impossible to even guess, so upload your workbook showing how you want it.

**jindon** · 11-30-2022, 05:16 PM

How is the code related to your attached workbook?

No sheet named "Total", "Import", so no idea.

**mfusfw** · 11-30-2022, 05:56 PM

Ahhh so sorry. The Attached workbook has the Macro in it with correct code

So sorry again

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    
    
    With Sheets("Source")
        a = .Range("a1", .Cells.SpecialCells(11)).Value
    End With
    
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 11)
    
    For i = 2 To UBound(a, 1)
        If a(i, 1) = "" Then Exit For
            n = n + 1
            b(n, 2) = a(i, 2) & " - " & a(i, 1)
            'b(n, 3) = a(i, 1)
        
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                b(n, 7) = a(1, ii)
                'b(n, 8) = a(1, ii)
                b(n, 8) = a(i, 1)
                b(n, 11) = a(i, ii)
                n = n + 1
            End If
        Next
        n = n - 1
    Next
    
    With Sheets("Outcome").Cells(1).Resize(, 11)
        .EntireColumn.ClearContents
        .Value = Array("*InvoiceNo", "*Customer", "*InvoiceDate", "*DueDate", "Terms", "Memo", "Item (Product / Service)", "ItemDescription", "ItemQuantity", "ItemRate", "*ItemAmount")
        
        

        .Rows(2).Resize(n) = b
    End With

End Sub

**jindon** · 12-02-2022, 02:22 AM

See if I understand your requirement.
This is a stand alone type so, shouldn't be called from your existsing code.

Sub test()
    Dim a, e, s, v, i As Long, ii As Long, n As Long, dic(1) As Object
    Dim invDate As Date, DueDate As Date, mngDate As String, adjDate As String
    invDate = Sheets("input").[d4]: DueDate = invDate + 9
    mngDate = Sheets("input").[g1].Text: adjDate = Sheets("input").[g2].Text
    Set dic(0) = CreateObject("Scripting.Dictionary")
    Set dic(1) = CreateObject("Scripting.Dictionary")
    a = Sheets("description").[a2].CurrentRegion.Value
    For i = 1 To UBound(a, 1)
        dic(0)(a(i, 1)) = Array(a(i, 3), a(i, 4))
    Next
    a = Sheets("source").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic(1).exists(a(i, 2)) Then
            dic(1)(a(i, 2)) = Array(CreateObject("Scripting.Dictionary"), a(i, 1))
        End If
        If Not dic(1)(a(i, 2))(0).exists(a(i, 1)) Then
            Set dic(1)(a(i, 2))(0)(a(i, 1)) = CreateObject("Scripting.Dictionary")
        End If
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then dic(1)(a(i, 2))(0)(a(i, 1))(a(1, ii)) = a(i, ii)
        Next
    Next
    ReDim a(1 To UBound(a, 1) * UBound(a, 2), 1 To 11)
    For Each e In dic(1)
        n = n + 1: a(n, 3) = invDate: a(n, 4) = DueDate: a(n, 5) = "Net 10"
        a(n, 6) = "The total amount due for this invoice will be drafted via ACH on the due date shown."
        a(n, 2) = e & IIf(dic(1)(e)(0).Count > 1, "", "_" & dic(1)(e)(1))
        For Each s In dic(1)(e)(0)
            For Each v In dic(1)(e)(0)(s)
                a(n, 7) = dic(0)(v)(0) & IIf(dic(1)(e)(0).Count > 1, "_" & dic(1)(e)(1), "")
                a(n, 8) = "Management Fee " & IIf(a(n, 7) Like "*?ADJ*", "Adjustment ", "") & _
                       "for Week Ending " & IIf(a(n, 7) Like "*?ADJ*", adjDate, mngDate) & ": " & _
                       dic(0)(v)(1)
                a(n, 11) = dic(1)(e)(0)(s)(v)
                n = n + 1
            Next
        Next
        n = n - 1
    Next
    With Sheets("outcome").Cells(1).Resize(, 11)
        .EntireColumn.ClearContents
        .Value = Array("*InvoiceNo", "*Customer", "*InvoiceDate", "*DueDate", _
                "Terms", "Memo", "Item (Product / Service)", "ItemDescription", _
                "ItemQuantity", "ItemRate", "*ItemAmount")
        .Rows(2).Resize(n) = a
        .Columns(11).Resize(n + 1).NumberFormatLocal = _
            "_(""$""* #,##0.00_);_(""$""* (#,##0.00);_(""$""* ""-""??_);_(@_)"
    End With
End Sub

**mfusfw** · 12-02-2022, 06:07 PM

Originally Posted by jindon

See if I understand your requirement.
This is a stand alone type so, shouldn't be called from your existsing code.

Sub test()
    Dim a, e, s, v, i As Long, ii As Long, n As Long, dic(1) As Object
    Dim invDate As Date, DueDate As Date, mngDate As String, adjDate As String
    invDate = Sheets("input").[d4]: DueDate = invDate + 9
    mngDate = Sheets("input").[g1].Text: adjDate = Sheets("input").[g2].Text
    Set dic(0) = CreateObject("Scripting.Dictionary")
    Set dic(1) = CreateObject("Scripting.Dictionary")
    a = Sheets("description").[a2].CurrentRegion.Value
    For i = 1 To UBound(a, 1)
        dic(0)(a(i, 1)) = Array(a(i, 3), a(i, 4))
    Next
    a = Sheets("source").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic(1).exists(a(i, 2)) Then
            dic(1)(a(i, 2)) = Array(CreateObject("Scripting.Dictionary"), a(i, 1))
        End If
        If Not dic(1)(a(i, 2))(0).exists(a(i, 1)) Then
            Set dic(1)(a(i, 2))(0)(a(i, 1)) = CreateObject("Scripting.Dictionary")
        End If
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then dic(1)(a(i, 2))(0)(a(i, 1))(a(1, ii)) = a(i, ii)
        Next
    Next
    ReDim a(1 To UBound(a, 1) * UBound(a, 2), 1 To 11)
    For Each e In dic(1)
        n = n + 1: a(n, 3) = invDate: a(n, 4) = DueDate: a(n, 5) = "Net 10"
        a(n, 6) = "The total amount due for this invoice will be drafted via ACH on the due date shown."
        a(n, 2) = e & IIf(dic(1)(e)(0).Count > 1, "", "_" & dic(1)(e)(1))
        For Each s In dic(1)(e)(0)
            For Each v In dic(1)(e)(0)(s)
                a(n, 7) = dic(0)(v)(0) & IIf(dic(1)(e)(0).Count > 1, "_" & dic(1)(e)(1), "")
                a(n, 8) = "Management Fee " & IIf(a(n, 7) Like "*?ADJ*", "Adjustment ", "") & _
                       "for Week Ending " & IIf(a(n, 7) Like "*?ADJ*", adjDate, mngDate) & ": " & _
                       dic(0)(v)(1)
                a(n, 11) = dic(1)(e)(0)(s)(v)
                n = n + 1
            Next
        Next
        n = n - 1
    Next
    With Sheets("outcome").Cells(1).Resize(, 11)
        .EntireColumn.ClearContents
        .Value = Array("*InvoiceNo", "*Customer", "*InvoiceDate", "*DueDate", _
                "Terms", "Memo", "Item (Product / Service)", "ItemDescription", _
                "ItemQuantity", "ItemRate", "*ItemAmount")
        .Rows(2).Resize(n) = a
        .Columns(11).Resize(n + 1).NumberFormatLocal = _
            "_(""$""* #,##0.00_);_(""$""* (#,##0.00);_(""$""* ""-""??_);_(@_)"
    End With
End Sub

This is REALLLLLLLY CLOSE to what is needed. I have uploaded the file with the new code in it...

On the Outcome Tab - G7:G11 is perfect. G12 would need to update to show as "MGMT FEE - 234 - BUF282" but instead it just grabs the same reference that same "MGMT FEE - 234 - BOI716" value. So it needs to pull that updated customer name to append to the Item field, if that makes sense?

This is absolutely amazing, though, I cannot believe how fast it is!!!

**jindon** · 12-02-2022, 11:56 PM

Ahhh, try change

                a(n, 7) = dic(0)(v)(0) & IIf(dic(1)(e)(0).Count > 1, "_" & dic(1)(e)(1), "")

to

                a(n, 7) = dic(0)(v)(0) & IIf(dic(1)(e)(0).Count > 1, "_" & s, "")

**mfusfw** · 12-11-2023, 10:39 PM

[post removed]

Reformat data - multiple Columns to rows

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Re: Reformat data - multiple Columns to rows

Thread Information

Users Browsing this Thread

Similar Threads

Reformat data in different cells to two rows

how to copy/past data from multiple rows/columns to multiple columns one single row?

[SOLVED] Macro to Reformat Rows that contain date, dollar amounts, and other data

How can I reformat some rows into columns in Excel?

How can I reformat some rows into columns in Excel?

Excel 2007 : Macro to reformat data from 1 row into 2 rows

[SOLVED] reformat columns to rows?

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions