if find the spicify word copy data

[parscon]

i need vba code for the below subject :
I have sheet that column A,b,C is empty and D,E,F has data. now I need to search column E and if find USD word ,copy data from D,E,F column to A,B,C column and clear(I do not want to delete the column just clear their content) the column D,E,F on the row.

Note: Also I have some row that there is not any data on E column .

Really I need this and it is your kind that can help me.

Thank you vey much .

[jolivanes]

If there is nothing to the right of Column G.
Try it on a copy of your workbook though.

Sub Maybe()
Dim c As Range
Application.ScreenUpdating = False
Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).AutoFilter 1, "USD"
For Each c In Range("E2:E" & Range("E" & Rows.Count).End(3)(1).Row).SpecialCells(12)
c.Offset(, -4).Resize(, 3).Delete Shift:=xlToLeft
Next c
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

[parscon]

Thank you very much , just small modification could you please add also check column A, B, C if they have data it will not do anything just if they are blank it will work.

[jolivanes]

Try This

Sub Maybe()
Dim c As Range
Application.ScreenUpdating = False
Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).AutoFilter 1, "USD"
For Each c In Range("E2:E" & Range("E" & Rows.Count).End(3)(1).Row).SpecialCells(12)
If WorksheetFunction.CountBlank(c.Offset(, -4).Resize(, 3)) = 3 Then _
c.Offset(, -4).Resize(, 3).Delete Shift:=xlToLeft
Next c
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

[parscon]

My Friend , Thank you very much , Work Fine .
Thank you again.

[snb]

Sub M_snb()
With UsedRange.Columns(5)
.AutoFilter 1, "USD"
For Each cl In .SpecialCells(12)
cl.Offset(, 1).Resize(, 3).Cut cl.Offset(, -4)
Next
.AutoFilter
End With
End Sub

[jolivanes]

@snb
I think misread/misunderstood the requirements.
Too much of a hurry? They don't play until sunday!

[snb]

@Joli
I think you are right

maybe:

Sub M_snb()
With UsedRange.Columns(5)
.AutoFilter 1, "USD"
For Each cl In .SpecialCells(12)
cl.Offset(, -1).Resize(, 3).Cut cl.Offset(, -4)
Next
.AutoFilter
End With
End Sub

or


Sub tst()
On Error Resume Next

Do
Columns(5).Find("USD", , , 1).Offset(, -4).Resize(, 3).Delete
Loop Until Err.Number <> 0
End Sub




I will be playing tomorrow; no hurry

[jolivanes]

@ snb
Before the OP came with the second request, I tried to get it all without looping as in



Sub Whatever()
Dim c As Range
Application.ScreenUpdating = False
Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).AutoFilter 1, "USD"
Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).SpecialCells(12).Offset(,-4).Resize(,3).Delete Shift:=xlToLeft
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub


However, that errors on the Offset and Resize line.
Googling more or less suggests that that cannot be done.
Do you know of a way without looping?
I suspect it indeed cannot be done because you would have used that I imagine.

[snb]

@Joli


Sub M_snb()
With UsedRange
.Sort Cells(1, 5)
With .Columns(5)
.AutoFilter 1, "USD"
.SpecialCells(12).Offset(1).SpecialCells(12).Offset(, -1).Resize(, 3).Cut .SpecialCells(12).Offset(1).SpecialCells(12).Cells(1).Offset(, -4)
.AutoFilter
End With
End With
End Sub