Macro change - help please

[RoyBatty]

Hi I have the following macro that if it finds a "y" in a cell in a sheet
called "current" it then writes data from that row onto another sheet
called "paid"

Can somebody let me know how to change the macro so that as well as copying
data to "paid" sheet it will also then change the cells with "y" on
"current" sheet to "d" for example, i'm hoping that will then stop duplicate
data being written if the macro is run multiple times

Many thanks if you can help.

here is the Macro

Sub paid()
Sheets("Current").Select
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim DestCell As Range
Dim TargetRng As Range

Application.ScreenUpdating = False
Set ShA = Worksheets("Current")
Set ShB = Worksheets("Paid")
'Set DestCell = ShB.Range("A2")
Set DestCell = ShB.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set TargetRng = ShA.Range("F2", ShA.Range("F" & Rows.Count).End(xlUp))

For Each cell In TargetRng
If cell.Value = "y" Then
ShA.Range("A" & cell.Row).Resize(1, 2).Copy DestCell
If cell.Offset(0, 2) = "ch" Then
DestCell.Offset(0, 2) = cell.Offset(0, 1)
Else
DestCell.Offset(0, 3) = cell.Offset(0, 1)
End If
Set DestCell = DestCell.Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Dave Peterson]

Just do it in your loop:

For Each cell In TargetRng
If cell.Value = "y" Then
ShA.Range("A" & cell.Row).Resize(1, 2).Copy DestCell
If cell.Offset(0, 2) = "ch" Then
DestCell.Offset(0, 2) = cell.Offset(0, 1)
Else
DestCell.Offset(0, 3) = cell.Offset(0, 1)
End If
Set DestCell = DestCell.Offset(1, 0)
'add this
cell.value = "d"
End If
Next cell

 

[RoyBatty]

Thanks for that works a treat

Although I have the Application.ScreenUpdating statements theres still a lot
of flickering any ideas /

cheers.

 

[RoyBatty]

Ok sorted, moved the false statement

thanks

Thanks for that works a treat

Although I have the Application.ScreenUpdating statements theres still a
lot of flickering any ideas /

cheers.