Add to existing macro

[bazwillrun]

Hi all, Is it possible that someone could help me add to the macro show
below
Need to add "dp" as an extra choice to enter in col H sheet A, and hav
that shown as column E in sheet B
Much appreciated if anybody can help

Here is a pic of what I mean

[image: http://i48.tinypic.com/4izey9.jpg]


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 = "p" 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)
cell.Value = "c"
End If
Next
Application.ScreenUpdating = True
End Su

 

[Ben McClave]

Hello,

I think that a Select Case will work better than the If Then statement here. It will also be easier to add new values as necessary. Here is a modified version of the For...Next portion of your code that worked for me:

For Each cell In TargetRng
If cell.Value = "p" Then
ShA.Range("A" & cell.Row).Resize(1, 2).Copy DestCell

Select Case cell.Offset(0, 2)
Case "ch"
DestCell.Offset(0, 2) = cell.Offset(0, 1)
Case "ca"
DestCell.Offset(0, 3) = cell.Offset(0, 1)
Case Else
DestCell.Offset(0, 4) = cell.Offset(0, 1)
End Select

Set DestCell = DestCell.Offset(1, 0)
cell.Value = "c"
End If
Next

 

[bazwillrun]

Hello,

I think that a Select Case will work better than the If Then statemen
here. It will also be easier to add new values as necessary. Here is
modified version of the For...Next portion of your code that worked fo
me:

Hi Ben
that works perfectly, and as you say new values can be easily added
Thanks very much for your time and assistance
much appreciate

 

[Ben McClave]

No problem, I'm glad to hear it works.