Transpose rows based on specific text

tezza

Active Member
Joined
Sep 10, 2006
Messages
375
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
  2. Web
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

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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:
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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
Back
Top