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

Here is a pic of what I mean




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 Sub

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

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

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