Move Cells in excel 1

[jupops]

Hi All

Could you help. Is there a possible way to move cells in a excel worksheet using VBA. At the moment the spreadsheet looks like:

a1 a2 a3 a4
b1 b2 b3 b4
c1 c2 c3 d4
d1 d2 d3 d4
e1 e2 e3 e4
f1 f2 f3 f4

and so on....

Is it possible to look like:

a1 a2 a3 a4 b1 b2 b3 b4 c1 c2 c3 c4
d1 d2 d3 d4 e1 e2 e3 e4 f1 f2 f3 f4
and so on again....

Thank You
Jupops

 

[TonyJollans]

Hi Jupops,

If you want to do exactly what your post says then this will do it for you.

Dim Row As Long

For Row = 1 To 65536

    If Cells(1, Row) = "" Then Exit For ' Stop at empty row
    Range("A" & Row + 1 & ":D" & Row + 1).Copy Destination:=Range("E" & Row)
    Range("A" & Row + 2 & ":D" & Row + 2).Copy Destination:=Range("I" & Row)
    Range(Row + 1 & ":" & Row + 2).Delete
    
Next

If your actual scenario is more complex then post back if you need more help.

Enjoy,
Tony

 

[jupops]

Thanks for your help, the scenario is a little more complex, so I could use more guidence if possible. the actual sheet looks like:

1038215 BECKHAM 33613 ZAP LIMITED
Single: 37cm 27cm 4cm 1.00kg POLYBAG
Outer 4 single units : 39cm 15cm 28cm 4.00kg ARGOS BOX
1038239 TAFFETA 41227 BEAUVALLET
Single: 38cm 25cm 9cm 2.05kg POLYBAG
Outer 3 single units : 40cm 30cm 30cm 20.50kg CORRUGATED CARTON

And I was hoping to either have this look like

1038215 BECKHAM 33613 ZAP LIMITED
Single: 37cm 27cm 4cm 1.00kg POLYBAG
Outer 4 single units : 39cm 15cm 28cm 4.00kg ARGOS BOX
1038239 TAFFETA 41227 BEAUVALLET
Single: 38cm 25cm 9cm 2.05kg POLYBAG
Outer 3 single units : 40cm 30cm 30cm 20.50kg CORRUGATED CARTON

Or

1038215 BECKHAM 33613 ZAP LIMITED Single: 37cm 27cm 4cm 1.00kg POLYBAG Outer 4 single units :39cm 15cm 28cm 4.00kg ARGOS
1038239 TAFFETA 41227 BEAUVALLET Single: 38cm 25cm 9cm 2.05kg POLYBAG Outer 3 single units :40cm 30cm 30cm 20.50kg CORRUGATED CARTON (these are all in one line)

There are over 500 entries.

I hope this is understandable, Thank You again.

Regards
Jupops

 

[TonyJollans]

Hi jujops,

It's not too bad. Provided they all come in groups of three rows and there are no intervening blank rows then this will concatenate as per your first post (and second case in your second post).

Dim Row As Long

For Row = Range("A65536").End(xlUp).Row - 2 To 1 Step -3

    Range(Cells(Row + 1, 1), Cells(Row + 1, 256).End(xlToLeft)).Copy _
        Destination:=Cells(Row, 256).End(xlToLeft).Offset(, 1)
    Range(Cells(Row + 2, 1), Cells(Row + 2, 256).End(xlToLeft)).Copy _
        Destination:=Cells(Row, 256).End(xlToLeft).Offset(, 1)
    Range(Row + 1 & ":" & Row + 2).Delete

Next

A couple of explanatory notes -

The End() construct starts at the end of the row / column and looks back / up for a non-blank cell. Using this ensures we get all the data and don't overwrite any.

The loop starts at the bottom and works up so that the deleted rows don't mess up the counting.

If you want to just indent the rows as shown in your first example, this alternative will do that instead.

Dim Row As Long

For Row = Range("A65536").End(xlUp).Row - 2 To 1 Step -3

    Range(Cells(Row + 1, 1), Cells(Row + 1, 256).End(xlToLeft)).Cut _
        Destination:=Cells(Row + 1, 4)
    Range(Cells(Row + 2, 1), Cells(Row + 2, 256).End(xlToLeft)).Cut _
        Destination:=Cells(Row + 2, 4)

Next

If the assumptions (that your data is always in blocks of three and has no intervening blank rows) don't hold then you'll need some other way of identifying which type of row is being looked at. Ask again if that is the case.

Enjoy,
Tony

 

[jupops]

Hi Tony

Did you know you are a life saver, could I ask you another question? The Second and third Row first cells contain Single Un and Outer con respectively, is there a way that a IF statement can be used, so if the blocks for some reason do not come in blocks of threes then the columns can be indented or made into the one line for each number as in my previous examples.

Regards

Jupops

 

[TonyJollans]

Hi jupops,

Checking the value of a cell is easy enough, with something like Range("A1&quot.Text, and what you ask can be done, but you must have a clear definition of what can be found, what criteria to check, and what action to take if the criteria are not met, particularly if there is any chance that the rows will not all be in groups of three. Simply to check cell content you could modify my code something like:

Dim Row As Long

For Row = Range("A65536").End(xlUp).Row - 2 To 1 Step -3

If Cells(Row + 1, 1).Text = "Single" Then

        Range(Cells(Row + 1, 1), Cells(Row + 1, 256).End(xlToLeft)).Copy _
            Destination:=Cells(Row, 256).End(xlToLeft).Offset(, 1)

Else

' Do something else

    End If

If Cells(Row + 2, 1).Text = "Outer" Then

        Range(Cells(Row + 2, 1), Cells(Row + 2, 256).End(xlToLeft)).Copy _
            Destination:=Cells(Row, 256).End(xlToLeft).Offset(, 1)

Else

' Do something else

    End If

    Range(Row + 1 & ":" & Row + 2).Delete

Next

Enjoy,
Tony