VBA to move the rightmost non-empty cell into column F

[RockandGrohl]

I have a table of data which contains address fields across columns C to F.

Column C will always be the first line of the address which is fine, however, the postcode, which needs to be in column F, can be in either D, E or F.

What I need is code that can start with a Do Until, end in a Loop, like this:

Do Until Cells(ActiveCell.Row, "A").Value = ""

<Code Needed Here>


Loop

So it will go down until it detects there is no value in A there it will stop. For every value in A, it will select the rightmost non-empty cell from D to F, cut it, then paste it in F.

Maybe with an Offset(0,1) function?


Here's what I have so far but it's not working...

Do Until Cells(ActiveCell.Row, "A").Value = ""
If Range("E") = "" Then
Range(Cells(ActiveCell.Row, "D")).Cut
Range(Cells(ActiveCell.Row, "F")).PasteSpecial xlValues
ActiveCell.Offset(0, 1).Activate


If Range("F") = "" Then
Range(Cells(ActiveCell.Row, "E")).Cut
Range(Cells(ActiveCell.Row, "F")).PasteSpecial xlValues


ActiveCell.Offset(1, 0).Activate
Loop

 

[RockandGrohl]

Ah I got it, like this:

Range("A2").Activate
Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "E").Value = "" Then
    Cells(ActiveCell.Row, "F").Value = Cells(ActiveCell.Row, "D").Value
    Cells(ActiveCell.Row, "D").ClearContents
    End If


    If Cells(ActiveCell.Row, "F").Value = "" Then
    Cells(ActiveCell.Row, "F").Value = Cells(ActiveCell.Row, "E").Value
    Cells(ActiveCell.Row, "E").ClearContents
    End If


    ActiveCell.Offset(1, 0).Activate
Loop