Macro change - help please
 

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

Macro change - help please
 

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 wrote:

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

Macro change - help please
 

Thanks for that works a treat

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

cheers.



"Dave Peterson" wrote in message
...
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 wrote:

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

Macro change - help please
 

Ok sorted, moved the false statement

thanks
"RoyBatty" wrote in message
...
Thanks for that works a treat

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

cheers.



"Dave Peterson" wrote in message
...
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 wrote:

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