trouble with code to move text

[JOUIOUI]

What I'm trying to accomplish is to move any cell in col I to column J if the
cell has more than 6 alph numeric characters. What happens is all the text
is being moved from Col I to col J reguardless of the number of characters.
I'm not sure what is wrong. Any help you can provide is appreciated, thanks


Sub MoveID()

' if text is greater than 6 characters in column I then move text to
same row in column J

Set rng = Range(Cells(2, "I"), Cells(Rows.Count, "I").End(xlUp))
For Each Cell In rng
If Len(Cell.Value) > 6 Then
Cells(Cell.Row, "J").Value = Cell.Value
End If
Cell.ClearContents
Next
On Error Resume Next

End Sub

 

[Norman Jones]

Hi Jouioui,

Your code works for me in the sense tha only text values longer than 6
characters are transferred and all the column I values are deleted,

Perhaps your values are longer than they appear; perhaps there are initial
or trailing spaces.?

Try therefore, changing:

If Len(Cell.Value) > 6 Then

to

If Len(Trim(cell.Value)) > 6 Then

 

[JOUIOUI]

Hi Norman,

That worked however all the other values in Col I 6 characters or less, in
other words the values I am not moving are being deleted. I just need to
delete the cells that are being moved. How could I accomplish that?

I appreciate your help thank you.

 

[Norman Jones]

Hi Jouioui,

Try:

'=============>>
Sub MoveID()
Dim rng As Range
Dim cell As Range

Set rng = Range(Cells(2, "I"), Cells(Rows.Count, "I").End(xlUp))
For Each cell In rng.Cells
If Len(Trim(cell.Value)) > 6 Then
Cells(cell.Row, "J").Value = cell.Value
cell.ClearContents
End If
Next
On Error Resume Next

End Sub
'<<=============