Excel Macro - Search Row for word, move cell value up 1 row

[larinda4]

Thank you for any help.

I have a rather large data dump I receive and I have to search column E for the word "to". If it comes up, I need the value to the right of the cell (column F) to be moved up 1 row (copy and paste or cut and paste, either one) and then continue searching column E for any other "to"'s.

It sounds very simple but I'm having a hard time finding a code for this.

Here's my code:

Sub Format_DFG()

Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
If InStr(cell.Text, "to") > 0 Then
cell.Offset(1, 0) = cell.Text
cell.ClearContents
End If
Next cell

Application.ScreenUpdating = True

End Sub

I appreciate the help.

 

[Joe4]

Welcome to the Board!

Does this do what you want?

Sub Format_DFG()

Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    If InStr(cell.Text, "to") > 0 Then
        cell.Offset(-1, 1) = cell.Offset(0, 1).Text
        cell.Offset(0, 1).ClearContents
    End If
Next cell

Application.ScreenUpdating = True

End Sub

 

[larinda4]

Welcome to the Board!

Does this do what you want?

Sub Format_DFG()

Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    If InStr(cell.Text, "to") > 0 Then
        cell.Offset(-1, 1) = cell.Offset(0, 1).Text
        cell.Offset(0, 1).ClearContents
    End If
Next cell

Application.ScreenUpdating = True

End Sub

THANK YOU SO MUCH! It works!!

If I wanted to cut and paste the value, how would I alter the code?

 

[Joe4]

THANK YOU SO MUCH! It works!!

If I wanted to cut and paste the value, how would I alter the code?

You could use:

Sub Format_DFG()

Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    If InStr(cell.Text, "to") > 0 Then
        cell.Offset(0, 1).Cut cell.Offset(-1, 1)
    End If
Next cell

Application.ScreenUpdating = True

End Sub

 

[larinda4]

You could use:

Sub Format_DFG()

Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    If InStr(cell.Text, "to") > 0 Then
        cell.Offset(0, 1).Cut cell.Offset(-1, 1)
    End If
Next cell

Application.ScreenUpdating = True

End Sub

The time I'll save scrolling through this data dump is crazy. Thank you so much, Joe! I really truly appreciate it.

 

[Joe4]

You are welcome.
Glad I was able to help!