Transpose rows based on specific text

tezza

Board Regular
Joined
Sep 10, 2006
Messages
165
Hi all

I'm trying to speed up the transpose process. When I copy an order form from online it pastes it all into Col A but I need to make it easier to read as I already have the next stages in place. The problem is the site changes from time to time and I have to redo the sheet.

The common factor in all of the items listed is where it says +Add to basket and that needs to be the final column before start a new row.

Have a look below to see what I'm trying to achieve:

Obviously transpose works but I can't keep redoing around 250 items each time the site decides to change something so I'm looking for a VBA fix to automate it for me if possible please.

Excel Workbook
A
2CleanWorks
3CleanWorks Light Weight Hygiene Cloth Blue
4
5Code: 001291
6Be the first to rate this product
74.50 Pack of 100 (ex. VAT)
8
95.40 inc. VAT
10Size 51 x 36cm, Colour Blue
11-
121
13+Add to basket
14
15CleanWorks
16CleanWorks Light Weight Hygiene Cloth Red
17
18Code: 001293
19Be the first to rate this product
204.50 Pack of 100 (ex. VAT)
21
225.40 inc. VAT
23Size 51 x 36cm, Colour Red
24-
251
26+Add to basket
27
28CleanWorks
29CleanWorks Light Weight Hygiene Cloth Yellow
30
31Code: 001294
32Be the first to rate this product
334.50 Pack of 100 (ex. VAT)
34
355.40 inc. VAT
36Size 51 x 36cm, Colour Yellow
37-
381
39+Add to basket
Copied Data


Excel Workbook
CDEFGHIJKLMN
2CleanWorksCleanWorks Light Weight Hygiene Cloth BlueCode: 001291Be the first to rate this product4.50 Pack of 100 (ex. VAT)05.40 inc. VATSize 51 x 36cm, Colour Blue-1+Add to basket
3CleanWorksCleanWorks Light Weight Hygiene Cloth RedCode: 001293Be the first to rate this product4.50 Pack of 100 (ex. VAT)05.40 inc. VATSize 51 x 36cm, Colour Red-1+Add to basket
4CleanWorksCleanWorks Light Weight Hygiene Cloth YellowCode: 001294Be the first to rate this product4.50 Pack of 100 (ex. VAT)05.40 inc. VATSize 51 x 36cm, Colour Yellow-1+Add to basket
Sorted Data
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,766
Office Version
  1. 2007
Platform
  1. Windows
The following may be an option. Transpose every 13 data.
The result will be on sheet2

Change data in red by your information

Code:
Sub Transpose_rows()
  Dim sh1 As Worksheet, i As Long
  Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Cells.ClearContents
  For i = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row Step 13
    Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A" & Rows.Count).End(xlUp)(2).Resize(1, 13).Value = Application.Transpose(sh1.Range("A" & i).Resize(13, 1).Value)
  Next
End Sub
 
Last edited:

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,578
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
How about this. I output to the same sheet starting in Cell C2 (last line of code) as you did not indicate anything different. Additionally, this will work only if the format of the original data does not change. Meaning that "+Add to basket" appears in a row number that is a multiple of 13.

Code:
Sub tpose()


    Dim arr, tpose
    Dim lRow As Long, x As Long, c As Long, d As Long


    c = 1: d = 1
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A1:A" & lRow)
    ReDim tpose(1 To UBound(arr, 1), 1 To 13)
    For x = 1 To UBound(arr)
        tpose(d, c) = arr(x, 1)
        c = c + 1
        If c = 14 Then
            c = 1
            d = d + 1
        End If
    Next
    Range("C2").Resize(UBound(tpose, 1), UBound(tpose, 2)) = tpose


End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,132,701
Messages
5,654,818
Members
418,155
Latest member
demasisi

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top