Replace Numbers

[Panoos64]

Hi all, i would like to write a VBA code so that to run through col. "E" and where find number should place it in col. "D" either the cell is blank or not. Below i present the original data and the expected result.

Many thanks in advance

	A	B	C	D	E
1	01/05/2016	1010102		457.25	125.36
2	01/05/2016	1010105		200.36
3	02/05/2016	1010108		101.35	253.65
4	03/05/2016	1010123		220.23
5	04/05/2016	2015456			478.36

<colgroup><col style="mso-width-source:userset;mso-width-alt:1133;width:23pt" width="31"> <col style="width:48pt" width="64" span="5"> </colgroup><tbody>
</tbody>

	A	B	C	D	E
1	01/05/2016	1010102		125.36
2	01/05/2016	1010105		200.36
3	02/05/2016	1010108		253.65
4	03/05/2016	1010123		220.23
5	04/05/2016	2015456		478.36

<colgroup><col style="mso-width-source:userset;mso-width-alt:1133;width:23pt" width="31"> <col style="width:48pt" width="64" span="5"> </colgroup><tbody>
</tbody>

 

[Joe4]

Here is a way that uses no loops.

Sub MyReplace()

    Dim lRow As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Enter temporary formulas in column F
    Range("F1:F" & lRow).FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1],RC[-2])"
    
'   Copy values from column F to column D
    Range("F1:F" & lRow).Copy
    Range("D1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
'   Clear columns E and F
    Columns("E:F").ClearContents
    
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

How about

Sub MoveColE()
   With Range("D2", Range("D" & Rows.Count).End(xlUp))
      .Value = Evaluate(Replace(Replace("if(@e<>"""",@e,@)", "@e", .Offset(, 1).Address), "@", .Address))
   End With
   Columns(5).ClearContents
End Sub

 

[Panoos64]

Thank u Joe. The code works perfect. Thanks once again for your support. Hv a great day

 

[Panoos64]

Thank u so much Fluf. The code works nicely and is what i was require. Hv a nice day

 

[Fluff]

Glad we could help & thanks for the feedback

 

[Rick Rothstein]

Here is one more for you to consider (similar in concept to what Fluff posted, but using a different set of function calls)...

[table="width: 500"]
[tr]
	[td]Sub CopyEtoD()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("D2:D" & LastRow) = Evaluate(Replace("IF(E2:E#="""",D2:D#,E2:E#)", "#", LastRow))
  Range("E2:E" & LastRow).ClearContents
End Sub[/td]
[/tr]
[/table]

 

[Panoos64]

Thank you Rick, the code works right and base to my data, Thanks once again for your support. Hv a lovely day