PDA

View Full Version : If Column X Contains Specific Text, Copy to Col X cell & del



harky
09-02-2019, 11:36 PM
This is my where i asked this question at, somehow is not what i want. Using excel formulas DO NOT allow to retain original value where i had copied from.
https://www.mrexcel.com/forum/excel-questions/1107659-vba-if-range-contains-cell-value-copy-than-del-2.html



*Need to retain original text format when copy cell.

If Column C cell contain 'Poster' or 'Index'
COPY "Col E Cell" to "Col A Cell"
And Delete Col E cell

or CUT & PASTE Col E to Col A



If Col C cell contain 'Poster' OR 'Index'


A
B
C
D
E


xxx
xxx
Poster
13
62131


xxx
xxx
Index
16
62141





COPY Col E Cell to Col A Cell Than


A
B
C
D
E


62131
xxx
Poster
13
62131


62141
xxx
Index
16
62141





Delete Col E


A
B
C
D
E


62131
xxx
Poster
13



62141
xxx
Index
16

harky
09-03-2019, 01:10 AM
Sorry to flood..

manage to solve it somehow.. but i think the code can improve better :)





Sub CopyNPasteNDelete()
Dim sh As Worksheet, lr As Long, rng As Range


Set sh = ThisWorkbook.Worksheets("path")
lr = sh.Cells(Rows.Count, "C").End(xlUp).Row


Set rng = sh.Range("C2:C" & lr)
For Each c In rng
If LCase(c.Value) = "poster" Then
sh.Range("E" & c.Row).Copy sh.Range("A" & c.Row)
sh.Range("E" & c.Row).Clear
End If
Next


Set rng = sh.Range("C2:C" & lr)
For Each c In rng
If LCase(c.Value) = "index" Then
sh.Range("E" & c.Row).Copy sh.Range("A" & c.Row)
sh.Range("E" & c.Row).Clear
End If
Next
End Sub

大灰狼1976
09-07-2019, 12:33 AM
Hi harky!
Because you want to keep the format, there's not much room for simplification.
Something like this:

Sub CopyNPasteNDelete()
Dim lr As Long, i&, s$
With ThisWorkbook.Worksheets("path")
lr = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To lr
s = LCase(.Cells(i, 3))
If s = "poster" Or s = "index" Then
.Cells(i, 5).Cut .Cells(i, 1)
End If
Next i
End With
End Sub