Transposing data in a specific format.

[JohnBecks]

Hi,

I have an excel which has an unlimited number of data that needs to be transposed into a specific format. The number of columns is fixed to four but the number of rows is constantly increasing. I would appreciate the help.

Example : ( Data )

Customer Invoice Date Amount
Customer A A-1 01/08/2021 100
Customer A A-2 02/08/2021 125
Customer A A-3 03/08/2021 150
Customer A A-4 04/08/2021 175
Customer B B-1 04/08/2021 200
Customer B B-2 05/08/2021 225
Customer B B-3 06/08/2021 225
Customer B B-4 07/08/2021 250
Customer B B-5 08/08/2021 275
Customer C C-1 06/08/2021 300
Customer C C-2 07/08/2021 325
Customer C C-3 08/08/2021 350
Customer D D-1 09/08/2021 375

Into something like this - So for every

Customer A	A-1	A-2	A-3	A-4
Customer A	01/08/2021	02/08/2021	03/08/2021	04/08/2021
Customer A	100	125	150	175
Customer B	B-1	B-2	B-3	B-4
Customer B	04/08/2021	05/08/2021	06/08/2021	07/08/2021
Customer B	200	225	225	250
Customer B	B-5	-	-	-
Customer B	08/08/2021	-	-	-
Customer B	275	-	-	-
Customer C	C-1	C-2	C-3	-
Customer C	06/08/2021	07/08/2021	08/08/2021	-
Customer C	300	325	350	-
Customer D	D-1	-	-	-
Customer D	09/08/2021	-	-	-
Customer D	375	-	-	-

Appreciate all the help

 

[rpaulson]

try this on a copy of your file

Sub Do_it()
wc = 2
wr = 1

For r = 2 To 14
cust = Cells(r, "A")
inv = Cells(r, "B")
iDate = Cells(r, "C")
amt = Cells(r, "D")

With Worksheets("Sheet2")

If cust <> .Cells(wr, "A") Or wc > 5 Then
    wc = 2
    wr = wr + 3
End If

.Cells(wr, "A") = cust
.Cells(wr, wc) = inv
.Cells(wr + 1, wc) = iDate
.Cells(wr + 2, wc) = amt
wc = wc + 1
End With

Next r

 

[JohnBecks]

try this on a copy of your file

Sub Do_it()
wc = 2
wr = 1

For r = 2 To 14
cust = Cells(r, "A")
inv = Cells(r, "B")
iDate = Cells(r, "C")
amt = Cells(r, "D")

With Worksheets("Sheet2")

If cust <> .Cells(wr, "A") Or wc > 5 Then
    wc = 2
    wr = wr + 3
End If

.Cells(wr, "A") = cust
.Cells(wr, wc) = inv
.Cells(wr + 1, wc) = iDate
.Cells(wr + 2, wc) = amt
wc = wc + 1
End With

Next r

Hi R.paulson,

I got the following error when pasting the code: " Compile Error - Expected end sub"

 

[Peter_SSs]

Welcome to the MrExcel board!

Not sure where the data is or where the results should go but this assumes data in columns A:D and it puts the results starting in column F

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, k As Long, z As Long
 
  a = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 2)
  z = 2:  k = -3
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      k = k + 4
      b(k, 1) = a(i, 1): b(k + 1, 1) = a(i, 1): b(k + 2, 1) = a(i, 1)
      c = 1
    End If
    c = c + 1
    If c > z Then
      ReDim Preserve b(1 To UBound(b), 1 To c)
      z = c
    End If
    b(k, c) = a(i, 2): b(k + 1, c) = a(i, 3): b(k + 2, c) = a(i, 4)
  Next i
  Range("F1").Resize(k + 2, UBound(b, 2)).Value = b
End Sub

Here is my sample data and results.

JohnBecks.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Customer	Invoice	Date	Amount		Customer A	A-1	A-2	A-3	A-4
2	Customer A	A-1	1/08/2021	100		Customer A	1/08/2021	2/08/2021	3/08/2021	4/08/2021
3	Customer A	A-2	2/08/2021	125		Customer A	100	125	150	175
4	Customer A	A-3	3/08/2021	150
5	Customer A	A-4	4/08/2021	175		Customer B	B-1	B-2	B-3	B-4	B-5
6	Customer B	B-1	4/08/2021	200		Customer B	4/08/2021	5/08/2021	6/08/2021	7/08/2021	8/08/2021
7	Customer B	B-2	5/08/2021	225		Customer B	200	225	225	250	275
8	Customer B	B-3	6/08/2021	225
9	Customer B	B-4	7/08/2021	250		Customer C	C-1	C-2	C-3
10	Customer B	B-5	8/08/2021	275		Customer C	6/08/2021	7/08/2021	8/08/2021
11	Customer C	C-1	6/08/2021	300		Customer C	300	325	350
12	Customer C	C-2	7/08/2021	325
13	Customer C	C-3	8/08/2021	350		Customer D	D-1
14	Customer D	D-1	9/08/2021	375		Customer D	9/08/2021
15						Customer D	375
Sheet1

 

[JohnBecks]

Hello Peter,

Appreciate the assistance with the above.

It definitely works. However, would it be possible to limit the number of columns to just five? This would be useful as some customers have over 1000 invoices.

So, instead of this

Customer B	B-1	B-2	B-3	B-4	B-5
Customer B	04/08/2021	05/08/2021	06/08/2021	07/08/2021	08/08/2021
Customer B	200	225	225	250	275

I can get something like this,

Customer B	B-1	B-2	B-3	B-4
Customer B	04/08/2021	05/08/2021	06/08/2021	07/08/2021
Customer B	200	225	225	250
Customer B	B-5
Customer B	08/08/2021
Customer B	275

Appreciate it

 

[Peter_SSs]

Try this version

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, k As Long
  
  Const MaxCols As Long = 5
  
  a = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To MaxCols)
  k = -3
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      k = k + 4
      b(k, 1) = a(i, 1): b(k + 1, 1) = a(i, 1): b(k + 2, 1) = a(i, 1)
      c = 1
    End If
    c = c + 1
    If c > MaxCols Then
      c = 2
      k = k + 3
      b(k, 1) = a(i, 1): b(k + 1, 1) = a(i, 1): b(k + 2, 1) = a(i, 1)
    End If
    b(k, c) = a(i, 2): b(k + 1, c) = a(i, 3): b(k + 2, c) = a(i, 4)
  Next i
  Range("F1").Resize(k + 2, UBound(b, 2)).Value = b
End Sub

 

[JohnBecks]

Try this version

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, k As Long
 
  Const MaxCols As Long = 5
 
  a = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To MaxCols)
  k = -3
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      k = k + 4
      b(k, 1) = a(i, 1): b(k + 1, 1) = a(i, 1): b(k + 2, 1) = a(i, 1)
      c = 1
    End If
    c = c + 1
    If c > MaxCols Then
      c = 2
      k = k + 3
      b(k, 1) = a(i, 1): b(k + 1, 1) = a(i, 1): b(k + 2, 1) = a(i, 1)
    End If
    b(k, c) = a(i, 2): b(k + 1, c) = a(i, 3): b(k + 2, c) = a(i, 4)
  Next i
  Range("F1").Resize(k + 2, UBound(b, 2)).Value = b
End Sub

Works perfectly.

Appreciate it very much.

Thank you!

 

[Peter_SSs]

You're welcome. Thanks for the confirmation.

 

[JohnBecks]

Hi Peter,

Was hoping you can help with some modification to the above code?

I have added more columns to the table.

So instead of this ,

Customer B	B-1	B-2	B-3	B-4	B-5
Customer B	04/08/2021	05/08/2021	06/08/2021	07/08/2021	08/08/2021
Customer B	200	225	225	250	275

becoming

Customer B	B-1	B-2	B-3	B-4
Customer B	04/08/2021	05/08/2021	06/08/2021	07/08/2021
Customer B	200	225	225	250
Customer B	B-5
Customer B	08/08/2021
Customer B	275

The new format will be (Highlighted Sections)

From This (Original sheet)

To

 

[Peter_SSs]

I am not fully understanding. Can you give the new raw sample data as a copyable mini-sheet with XL2BB and then the expected results also with XL2BB?