vba find text , move entire cell to the same row column C

I have macros, which search word "abc" in column D, the move this cell to column C:

 
Sub MoveDataD()
Dim myrange, cell As Range
Set myrange = ActiveSheet.Range("D1:D500")
For Each cell In myrange
    If Left(cell.Value, 3) = "abc" Then
      cell.Offset(0, -1).Value = cell.Value
        cell.ClearContents
        End If
Next cell
End Sub

I need the same only search range must be all active columns starting from D , e.g. D1:W5000. All found cells should move to column C.

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

No, it will not happen, the data are unique and the length is not 3, but more, it is just example. So, thanks for good remark, but pls do not worry about it.

OK
Assuming that "abc" does not repeat in any row, you can test the following code

Sub MoveDataD2()
Dim Wsht As Worksheet
Dim LastRow, LastCol As Long

Set Wsht = ActiveSheet
With Wsht
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        
For i = 1 To LastRow
    LastCol = .Cells(i, Columns.Count).End(xlToLeft).Column
    For j = 4 To LastCol
        If Left(Cells(i, j).Value, 3) = "abc" Then
            Cells(i, 3).Value = Cells(i, j).Value
            Cells(i, j).ClearContents
            Exit For
        End If
    Next j
Next i
End With

End Sub

in case you have a duplicate in the same row, it will take just the first from left

If you don't have formulas in any of the cells in column c or the cells you are searching you could use this.
If you don't mind having the formulas replaced with their results, you could use this.

It will run very fast on large data sets.

If you have formulas and want to keep them in place, then don't use this.

Sub MoveToColumnC()
Dim ws As Worksheet, lr As Long, lc As Long, arrC, arrData, j As Long, jj As Long
Set ws = ActiveSheet
lr = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                                    SearchDirection:=xlPrevious, MatchCase:=False).Row
lc = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
                                    SearchDirection:=xlPrevious, MatchCase:=False).Column
With ws
    arrC = .Range("C1:C" & lr)
    arrData = .Range(.Cells(1, 4), .Cells(lr, lc))
End With

        For j = 1 To UBound(arrData, 1)
            For jj = 1 To UBound(arrData, 2)
                If arrData(j, jj) = "abc" Then
                    arrC(j, 1) = arrData(j, jj)
                    arrData(j, jj) = Empty
                    GoTo 1
                End If
            Next jj
1       Next j
Range("C1").Resize(UBound(arrC, 1), 1) = arrC
Range("D1").Resize(UBound(arrData, 1), UBound(arrData, 2)) = arrData

End Sub

It will run very fast on large data sets.

Hi skywriter
I'm not used to work with large data sets, so...normaly I don't care about speed.
I'd like to learn why your idea of comparing inside the array is faster than comparing cells themselves.
As far as I can see, there is the main difference between both codes

Vicho

It was a good idea your aproach for lc and lr, as it covers the posibility of empty cells inside the db.