Looping from bottom to cut/paste varying length sections of column to next available column

DTime

New Member
Joined
Sep 22, 2017
Messages
8
Hey Guys,

I've been trying to figure this out but could really use some help. I have an output file from a machine that comes in a long list in column A. I'm trying to write a vba macro that goes through the list and moves a varying length section (based on header) to the next available row.

For example, if I have the list below, I want to move all the buckets to separate columns.

[TABLE="width: 88"]
<colgroup><col width="88" style="width:66pt"> </colgroup><tbody>[TR]
[TD="width: 88"][bucket_1[/TD]
[/TR]
[TR]
[TD]apple=1[/TD]
[/TR]
[TR]
[TD]banana=1[/TD]
[/TR]
[TR]
[TD]carrot=1[/TD]
[/TR]
[TR]
[TD][bucket_2[/TD]
[/TR]
[TR]
[TD]apple=1[/TD]
[/TR]
[TR]
[TD]carrot=1[/TD]
[/TR]
[TR]
[TD]pearl=0[/TD]
[/TR]
[TR]
[TD]jam=1[/TD]
[/TR]
[TR]
[TD]coffee=1[/TD]
[/TR]
[TR]
[TD]rock=1[/TD]
[/TR]
[TR]
[TD][bucket_3[/TD]
[/TR]
[TR]
[TD]apple=0[/TD]
[/TR]
[TR]
[TD]banana=0[/TD]
[/TR]
[TR]
[TD]carrot=1[/TD]
[/TR]
[TR]
[TD]pearl=1[/TD]
[/TR]
[TR]
[TD]jam=1[/TD]
[/TR]
[TR]
[TD]coffee=0[/TD]
[/TR]
[TR]
[TD]rock=1[/TD]
[/TR]
[TR]
[TD][bucket_4[/TD]
[/TR]
[TR]
[TD]apple=1[/TD]
[/TR]
[TR]
[TD]banana=1[/TD]
[/TR]
[TR]
[TD]pearl=0[/TD]
[/TR]
[TR]
[TD]coffee=0[/TD]
[/TR]
[TR]
[TD="class: xl63"][bucket_5[/TD]
[/TR]
[TR]
[TD]apple=0[/TD]
[/TR]
[TR]
[TD]banana=0[/TD]
[/TR]
[TR]
[TD]carrot=0[/TD]
[/TR]
[TR]
[TD]pearl=1[/TD]
[/TR]
[TR]
[TD]jam=0[/TD]
[/TR]
[TR]
[TD]coffee=0[/TD]
[/TR]
[TR]
[TD]rock=0[/TD]
[/TR]
[TR]
[TD]Friday=1[/TD]
[/TR]
</tbody>[/TABLE]


What I think that I need is to loop from the bottom and cut and paste when the loop finds the Bucket... but Im not super sure how in VBA. Any help would be Amazing!
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
so does everything under bucket 5 into column E, everything above bucket 5 and below bucket 4 go to column D and so forth?
 
Upvote 0
so does everything under bucket 5 into column E, everything above bucket 5 and below bucket 4 go to column D and so forth?

That would be the idea, but I don't think that it matters if bucket 5 went to column B and so forth which seems the easier path to take right?
 
Upvote 0
Will the name of each bucket be structured EXACTLY as you have shown it, i.e. "[bucket_5", and be in sequential order?
 
Last edited:
Upvote 0
How about
Code:
Sub RearangeOnBracket()

    Dim Ar As Areas
    Dim Cnt As Long
    Dim Col As Long

Application.ScreenUpdating = False

    Columns(1).Insert
    With Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)
        .Value = Evaluate("if(left(" & .Offset(, 1).Address & "1)=""["",1,"""")")
        Set Ar = .SpecialCells(xlBlanks).Areas
    End With
    
    Col = 3
    For Cnt = 2 To Ar.Count
        Ar(Cnt).Offset(-1, 1).Resize(Ar(Cnt).Rows.Count + 1).Cut Cells(1, Col)
        Col = Col + 1
    Next Cnt
    Columns(1).Delete
    
End Sub
 
Last edited:
Upvote 0
Will the name of each bucket be structured EXACTLY as you have shown it, i.e. "[bucket_5", and be in sequential order?

The actually machine output looks like this [Magazine0_Pot001]. The structure is always the same and the number increments up by 1.
 
Upvote 0
Try Fluff's code. It looks like that should work for you.
 
Upvote 0
Try Fluff's code. It looks like that should work for you.

It definitely worked! I'm going to have to spend some time figuring out how lol For my understanding, how would I make it increment every other column?

Thanks!
 
Upvote 0
How about
Code:
Sub RearangeOnBracket()

    Dim Ar As Areas
    Dim Cnt As Long
    Dim Col As Long

Application.ScreenUpdating = False

    Columns(1).Insert
    With Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)
        .Value = Evaluate("if(left(" & .Offset(, 1).Address & "1)=""["",1,"""")")
        Set Ar = .SpecialCells(xlBlanks).Areas
    End With
    
    Col = 3
    For Cnt = 2 To Ar.Count
        Ar(Cnt).Offset(-1, 1).Resize(Ar(Cnt).Rows.Count + 1).Cut Cells(1, Col)
        Col = Col + 1
    Next Cnt
    Columns(1).Delete
    
End Sub

Thank you, Fluff! I appreciate the help!
 
Upvote 0
Change this
Code:
Col = Col + 1
to
Code:
Col = Col + [COLOR=#0000ff]2[/COLOR]
Forgot this
Code:
    Col = [COLOR=#0000ff]4[/COLOR]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

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