# Transposing data in a specific format.

#### JohnBecks

##### New Member
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

### Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

#### rpaulson

##### Well-known Member
try this on a copy of your file
VBA Code:
``````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

##### New Member
try this on a copy of your file
VBA Code:
``````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

##### MrExcel MVP, Moderator
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

VBA Code:
``````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
ABCDEFGHIJK
1CustomerInvoiceDateAmountCustomer AA-1A-2A-3A-4
2Customer AA-11/08/2021100Customer A1/08/20212/08/20213/08/20214/08/2021
3Customer AA-22/08/2021125Customer A100125150175
4Customer AA-33/08/2021150
5Customer AA-44/08/2021175Customer BB-1B-2B-3B-4B-5
6Customer BB-14/08/2021200Customer B4/08/20215/08/20216/08/20217/08/20218/08/2021
7Customer BB-25/08/2021225Customer B200225225250275
8Customer BB-36/08/2021225
9Customer BB-47/08/2021250Customer CC-1C-2C-3
10Customer BB-58/08/2021275Customer C6/08/20217/08/20218/08/2021
11Customer CC-16/08/2021300Customer C300325350
12Customer CC-27/08/2021325
13Customer CC-38/08/2021350Customer DD-1
14Customer DD-19/08/2021375Customer D9/08/2021
15Customer D375
Sheet1

#### JohnBecks

##### New Member

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.

 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

##### MrExcel MVP, Moderator
Try this version

VBA Code:
``````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

##### New Member
Try this version

VBA Code:
``````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

##### MrExcel MVP, Moderator
You're welcome. Thanks for the confirmation.

Replies
0
Views
68
Replies
4
Views
157
Replies
1
Views
186
Replies
11
Views
159
Replies
15
Views
357

1,148,284
Messages
5,745,846
Members
423,981
Latest member
ph1l

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back