VBA: If Range Contains Cell Value Copy than del

[harky]

I need help


If Col C cell contain 'Poster' OR 'Index' COPY TO
Col E Cell to Col A Cell Than
Delete Col E E

the flow is

*xxx refer to some text

If Col C cell contain 'Poster' OR 'Index'
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]xxx[/TD]
[TD]Poster[/TD]
[TD]13[/TD]
[TD]62131[/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]xxx[/TD]
[TD]Index[/TD]
[TD]16[/TD]
[TD]62141[/TD]
[/TR]
</tbody>[/TABLE]


COPY TO Col E Cell to Col A Cell Than
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]62131[/TD]
[TD]xxx[/TD]
[TD]Poster[/TD]
[TD]13[/TD]
[TD]62131[/TD]
[/TR]
[TR]
[TD]62141[/TD]
[TD]xxx[/TD]
[TD]Index[/TD]
[TD]16[/TD]
[TD]62141[/TD]
[/TR]
</tbody>[/TABLE]


Delete Col E
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]62131[/TD]
[TD]xxx[/TD]
[TD]Poster[/TD]
[TD]13[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]62141[/TD]
[TD]xxx[/TD]
[TD]Index[/TD]
[TD]16[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[harky]

somehow like this code but dunno why it not working

Set sh = Sheets("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) = "Index" Then
            sh.Range("E" & c.Row).Cut sh.Range("A" & c.Row)
        End If
    Next
End Sub

 

[harky]

I manage to use this code to make it work..... but using cut and paste will cause the formula to had error.

Some how, the formula which i have it on Col F.
=IF(OR(A2="",C2=""),"",B2&C2&"_"&D2&""&E2&"")


When i active this code, it will cut E to A but end up my formula is having error.
=IF(OR(#REF!="",C16=""),"",B16&C16&"_"&D16&""&A16&"")

any idea, how to avoid tht?

Sub CutNPaste()
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).Cut sh.Range("A" & c.Row)
        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).Cut sh.Range("A" & c.Row)
        End If
    Next
   
End Sub

 

[harky]

Sorry to flood..

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

Sub CutNPasteNDelete()
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

 

[harky]

should be Sub CopyNPasteNDelete()

 

[Rick Rothstein]

Give this a try in a copy of your workbook.
I have assumed no empty cells among the column A data & same for column C.

Sub Poster_Index()
  With Range("A1:E" & Range("C" & Rows.Count).End(xlUp).Row)
    .Columns(1).Value = Evaluate(Replace(Replace(Replace("IF(ISNUMBER(SEARCH(""|""&#C&""|"",""|Poster|Index|"")),#E ,#A )", "#C", .Columns(3).Address), "#E ", .Columns(5).Address), "#A ", .Columns(1).Address))
    .Columns(5).Value = Evaluate(Replace(Replace("IF(ISNUMBER(SEARCH(""|""&#C&""|"",""|Poster|Index|"")),"""",#E )", "#C", .Columns(3).Address), "#E ", .Columns(5).Address))
  End With
End Sub

A little more compact...

Sub Test()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1:A" & LastRow) = Evaluate(Replace("IF((C1:C#=""Poster"")+(C1:C#=""Index""),E1:E#,A1:A#)", "#", LastRow))
  Range("E1:E" & LastRow) = Evaluate(Replace("IF((C1:C#=""Poster"")+(C1:C#=""Index""),"""",E1:E#)", "#", LastRow))
End Sub

 

[harky]

i need to retain the original format which i had..

If replace, does tht mean it wont copy the format which i had on col E?

A little more compact...

Sub Test()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1:A" & LastRow) = Evaluate(Replace("IF((C1:C#=""Poster"")+(C1:C#=""Index""),E1:E#,A1:A#)", "#", LastRow))
  Range("E1:E" & LastRow) = Evaluate(Replace("IF((C1:C#=""Poster"")+(C1:C#=""Index""),"""",E1:E#)", "#", LastRow))
End Sub