Reformat data - multiple Columns to rows

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