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

[DTime]

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.

[bucket_1

apple=1

banana=1

carrot=1

[bucket_2

apple=1

carrot=1

pearl=0

jam=1

coffee=1

rock=1

[bucket_3

apple=0

banana=0

carrot=1

pearl=1

jam=1

coffee=0

rock=1

[bucket_4

apple=1

banana=1

pearl=0

coffee=0

[bucket_5

apple=0

banana=0

carrot=0

pearl=1

jam=0

coffee=0

rock=0

Friday=1

<colgroup><col width="88" style="width:66pt"> </colgroup><tbody>
</tbody>

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!

 

[DTime]

Change this

Col = Col + 1

to

Col = Col + [COLOR=#0000ff]2[/COLOR]

Forgot this

    Col = [COLOR=#0000ff]4[/COLOR]

To go for gold, how would it be altered to cut and paste the cells in column B to go with those in Column A? You've been great!

 

[Fluff]

To go for gold, how would it be altered to cut and paste the cells in column B to go with those in Column A? You've been great!

I'm afraid you've lost me on this.
Could you possibly re-explain?

 

[Rick Rothstein]

For my understanding, how would I make it increment every other column?

Below is another macro that you can consider. There is a variable named Increment which controls the column offsets... 1 means count over one column to the next outputted column (your original request), 2 means to count over two columns to the next outputted column (your request above), and so on.

[table="width: 500"]
[tr]
	[td]Sub RearangeOnBracket()
  Dim X As Long, Increment As Long, Ar As Variant
  [B][COLOR="#FF0000"]Increment = 2[/COLOR][/B]
  Columns("A").Replace "[", "=XXX", xlPart, , , , False, False
  Set Ar = Columns("A").SpecialCells(xlConstants).Areas
  For X = 2 To Ar.Count
    Ar(X).Offset(-1).Resize(Ar(X).Count + 1).Cut Cells(1, X * Increment - Increment + 1)
  Next
  Rows(1).Replace "=XXX", "[", xlPart, , , , False, False
End Sub[/td]
[/tr]
[/table]