copying to adjacent cell

[bertieboots]

Hi all,

Is there a way to loop through a column(lets say A),where most of the cells are empty(size of the column will varying in length),but when the loop hits a cell that has data in(please see Fig1)the data is copied over to the adjacent cell in the next column.Any help appreciated

Fig1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A
[/TD]
[TD]B
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]apple
[/TD]
[TD]apple
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]grapes
[/TD]
[TD]grapes
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]pear
[/TD]
[TD]pear
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Joe4]

Why not just do a Copy and Paste on the whole column?
That should do what you describe without having to do any loops.

 

[jeffreybrown]

See if this works for you...

Sub A_B()
    Dim lr As Long: lr = Range("A" & Rows.Count).End(xlUp).Row
    Dim cell As Range
    For Each cell In Range("A2:A" & lr)
        If cell.Value <> "" Then cell.Offset(0, 1) = cell.Value
    Next cell
End Sub

 

[bertieboots]

Hi Jeffrey,
Thanks for the reply.The code partly works in as much as it copies the cells with data from column A to the adjacent cell in column B.But it appears to copy all of the empty cells over from column A to B also,this has the effect of replacing any data in column B.This is my fault because I didn't explain properly what I was trying to do.I failed to mention that there will be some data in Col B,but there will be empty cells corresponding in Col B waiting to take the adjacent cells data from Col A.Please see the two tables below. Fig 1 is before the code is run,and you can see two empty cells in Col B,waiting for the code from ColA.Then Fig2 shows what happens after the code is run,with the data from Col A moved over to the available cells in ColB.Hope this is a better explanation.Many thanks and any help appreciated
Fig 1
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]cabbage[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]sprouts[/TD]
[/TR]
[TR]
[TD]grapes[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]peas[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]onions[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]cauliflower[/TD]
[/TR]
[TR]
[TD]apples[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]green peppers[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]lettuce[/TD]
[/TR]
</tbody>[/TABLE]
Fig2
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]cabbage[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]sprouts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]grapes[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]peas[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]onions[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]cauliflower[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]apples[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]green peppers[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]lettuce[/TD]
[/TR]
</tbody>[/TABLE]

 

[jeffreybrown]

Try

Sub A_B()
    Dim lr As Long: lr = Range("A" & Rows.Count).End(xlUp).Row
    Dim cell As Range
    For Each cell In Range("A2:A" & lr)
        With cell
            If .Value <> "" And .Offset(0, 1) = "" Then
                .Offset(0, 1) = .Value
                .Value = ""
            End If
        End With
    Next cell
End Sub

 

[bertieboots]

Hi Jeff
Works GREAT!! many thanks for that.
kind regards
bertie