Moving text

[handysmurf]

I need to move text from one cell to another ... without overwriting the data already in the cell. Also entering a line return between the new text and old. I have many many cells that I need to do this with.

So in this example copy from C2 to D2... it would end up looking like D1

 

[DanteAmor]

Suggest this change

With Range("C1:D" & Range("A" & Rows.Count).End(3).Row)

I missed putting that part. Thanks Peter.


Here is my macro updated with Peter's observation.

Sub MovingText()
  Dim i As Long, a As Variant
  
  With Range("C1:D" & Range("A" & Rows.Count).End(3).Row)
    a = .Value
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "" Then
        a(i, 2) = a(i, 1) & Chr(10) & a(i, 2)
        a(i, 1) = ""
      End If
    Next
    .Value = a
  End With
End Sub

 

[Peter_SSs]

That worked perfectly ... thank you!!

You're welcome. Glad we could help - joint effort.

 

[DanteAmor]

Peter solved the riddle ... but thank you for your time as well

I already saw it and put my updated macro.

 

[DanteAmor]

View attachment 122152

I don't understand how the macro works for me with the same example, but with your example the macro sends an error. Maybe it's the excel version.
My mistake was knowing which column contained the last row with data and I forgot to set the Row property.

The important thing is that you already have a solution.

 

[Peter_SSs]

BTW, Dante's code (& mine) allow for if a cell in column C is empty but not if a cell in column D is empty (or both). In case that can happen (& you don't want a stray linefeed in column D data) ..

Sub MovingText_v2()
  Dim i As Long, a As Variant
 
  With Range("C1:D" & Range("A" & Rows.Count).End(3).Row)
    a = .Value
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "" Then
        a(i, 2) = a(i, 1) & IIf(a(i, 2) = "", "", Chr(10) & a(i, 2))
        a(i, 1) = ""
      End If
    Next
    .Value = a
  End With
End Sub

.. or you could do it all at once without any looping

Sub MovingText_v3()
  With Range("C1:D" & Range("A" & Rows.Count).End(xlUp).Row)
    .Columns(2).Value = Evaluate("BYROW(" & .Address & ",LAMBDA(r,TEXTJOIN(CHAR(10),1,r)))")
    .Columns(1).ClearContents
  End With
End Sub