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!

 

[crazydragon84]

so does everything under bucket 5 into column E, everything above bucket 5 and below bucket 4 go to column D and so forth?

 

[DTime]

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?

 

[Joe4]

Will the name of each bucket be structured EXACTLY as you have shown it, i.e. "[bucket_5", and be in sequential order?

 

[Fluff]

How about

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

 

[DTime]

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.

 

[Joe4]

Try Fluff's code. It looks like that should work for you.

 

[DTime]

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!

 

[DTime]

How about

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!

 

[Fluff]

Change this

Col = Col + 1

to

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

Forgot this

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