Rows to Columns

[Gerrit.B]

In my Excel sheet I have multiple rows with data from the same customer. (orange)
I need to transpose this data to one row per customer, where all invoice numbers are in 1 line as shown in image (green part)

How can this be done?

 

[Gerrit.B]

Assuming your data is sorted by customer as per your sample, try this with a copy of your data

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, r As Long, c As Long, MaxCols As Long
 
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 2)
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      r = r + 1
      b(r, 1) = a(i, 1)
      b(r, 2) = a(i, 2)
      c = 2
    Else
      c = c + 1
      If c > MaxCols Then
        MaxCols = c
        ReDim Preserve b(1 To UBound(b), 1 To MaxCols)
      End If
      b(r, c) = a(i, 2)
    End If
  Next i
  With Range("E1").Resize(, MaxCols)
    .Formula = "=""Invoice ""&COLUMNS($E1:E1)-1"
    .Value = .Value
    .Cells(1).ClearContents
    .Offset(1).Resize(r).Value = b
    .EntireColumn.AutoFit
  End With
End Sub

BTW ..
I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Also suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.

Hi Peter_SSs,

I use this code also for other rows in my sheet.
So sometimes duplicates are possible.
Could I change a line of code to avoid duplicate results?

Regards Gerrit.

 

[Peter_SSs]

So sometimes duplicates are possible.

By that you mean 2 or more rows with the same Customer and same Invoice?

 

[alansidman]

Note to Sandy. I guess we are invisible as no response from OP.

 

[Gerrit.B]

By that you mean 2 or more rows with the same Customer and same Invoice?

Yes, if I have 2 rows for the same customer, with same invoice number.
There is a another column with 2 different email addresses.
Then it will report the 2 same invoices separate, instead of only once.

 

[Gerrit.B]

Note to Sandy. I guess we are invisible as no response from OP.

Thanks Alan and Sandy,

I never used Power Query, so I used the solution Peter offered to me.
(already downloaded Power Query to try! )

 

[sandy666]

Helloooo! I am here !!!!!
@alansidman , thanks for waking the demons

@Gerrit.B
you have Power Query build in (XL2016 and XL2019)

 

[Peter_SSs]

Yes, if I have 2 rows for the same customer, with same invoice number.

Will those two (or more) rows always be together like this?

Gerrit.B 2020-07-14 1.xlsm
	A	B
1	Customer	Invoice
2	Customer 1	55
3	Customer 2	56
4	Customer 2	57
5	Customer 2	57
6	Customer 2	58
7	Customer 3	59
Sheet1

Or could the duplicates be apart like this?

Gerrit.B 2020-07-14 1.xlsm
	A	B
1	Customer	Invoice
2	Customer 1	55
3	Customer 2	56
4	Customer 2	57
5	Customer 2	58
6	Customer 2	57
7	Customer 3	59
Sheet1

 

[alansidman]

@Gerrit.B

I never used Power Query,

Isn't that why you came to this site for help? To learn how to solve your issue?

 

[Gerrit.B]

Will those two (or more) rows always be together like this?

Gerrit.B 2020-07-14 1.xlsm
	A	B
1	Customer	Invoice
2	Customer 1	55
3	Customer 2	56
4	Customer 2	57
5	Customer 2	57
6	Customer 2	58
7	Customer 3	59
Sheet1

Or could the duplicates be apart like this?

Gerrit.B 2020-07-14 1.xlsm
	A	B
1	Customer	Invoice
2	Customer 1	55
3	Customer 2	56
4	Customer 2	57
5	Customer 2	58
6	Customer 2	57
7	Customer 3	59
Sheet1

I can make make sure it is always as in your first table!

 

[Peter_SSs]

I can make make sure it is always as in your first table!

In that case the modification is fairly simple. Try this version.

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, r As Long, c As Long, MaxCols As Long
  
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 2)
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      r = r + 1
      b(r, 1) = a(i, 1)
      b(r, 2) = a(i, 2)
      c = 2
    Else
      If a(i, 2) <> a(i - 1, 2) Then
        c = c + 1
        If c > MaxCols Then
          MaxCols = c
          ReDim Preserve b(1 To UBound(b), 1 To MaxCols)
        End If
        b(r, c) = a(i, 2)
      End If
    End If
  Next i
  With Range("E1").Resize(, MaxCols)
    .Formula = "=""Invoice ""&COLUMNS($E1:E1)-1"
    .Value = .Value
    .Cells(1).ClearContents
    .Offset(1).Resize(r).Value = b
    .EntireColumn.AutoFit
  End With
End Sub

Gerrit.B 2020-07-14 1.xlsm
	A	B	C	D	E	F	G	H
1	Customer	Invoice				Invoice 1	Invoice 2	Invoice 3
2	Customer 1	55			Customer 1	55
3	Customer 2	56			Customer 2	56	57	58
4	Customer 2	57			Customer 3	59
5	Customer 2	57			Customer 4	60	61
6	Customer 2	58
7	Customer 3	59
8	Customer 4	60
9	Customer 4	61
Sheet1