VBA - Move text in one cell if another cell is not blank

[Scott Wagner]

In a worksheet I have some cells that aren't arranged consistently that
contain product information. In most cases the cells are arranged fine, but
there are certain lines that I am having trouble with and I want to
reposition cell contents around.

In the cases I want to effect column A contains a number, in all other cases
that cell is empty. Hoping column A can be used as a "trigger" for the VBA.

Row 1 contains headers, so all this begins on row 2.

Here is the basic logic:

IF A2 is not empty THEN
Move contents of C2 to D2
Move contents of B3 to C2


Example (before):
A | B | C | D |
1 | 1 | Text1 | |
| Text2 | | |
2 | 1 | Text3 | |
| Text4 | | |
3 | 1 | Text5 | |
| Text6 | | |

Example (after):
A | B | C | D |
1 | 1 | Text1 | Text2|
| | | |
2 | 1 | Text3 | Text4 |
| | | |
3 | 1 | Text5 | Text6 |
| | | |

Thanks in advance!

Scott

 

[Crowbar via OfficeKB.com]

I have tested this and it worked fine. Don't know how clued up on this you
are so here are a few things:

If you place this within you worksheet it will activate evertime you open it,
if you don't want this then change the sub name to something else.

This current sub will only work on a sheet named Sheet1, if your sheet is
called something else then rename sheet1 (on the thrid line) to
Sheets("YOUR SHEET NAME")

Please note that this ONLY does as you stated, which is: -

If Ax is empty then
Cx is put into Dx and
Bx + 1 is put into Cx


Sub auto_open()

For x = 1 To 65536
If Sheet1.Cells(x, 1).Value > "" Then
Range("C" & x).Cut
Range("D" & x).Select
ActiveSheet.Paste

Range("B" & x + 1).Cut
Range("C" & x).Select
ActiveSheet.Paste
End If
Next x

End Sub


Regards Crowbar

Email: (e-mail address removed)

 

[Scott Wagner]

Thanks~!