Try:
Sub DerbysGal()
Dim x As String
Dim y As String
Dim z As String
Dim xx As Integer
Dim yy As Integer
Dim zz As Integer
Dim i As Long
Application.ScreenUpdating = False
x = "ADDRESS1"
y = "ADDRESS2"
z = "ADDRESS3"
Range("B1").Select
Do Until ActiveCell.Column = ActiveSheet.UsedRange.Columns.count
Select Case ActiveCell.Value
Case Is = x
xx = ActiveCell.Column
Case Is = y
yy = ActiveCell.Column
Case Is = z
zz = ActiveCell.Column
End Select
ActiveCell.Offset(, 1).Select
Loop
For i = Range("A" & Rows.count).End(3)(1).Row To 2 Step -1
If Cells(i, yy).Value Like "*PO*" And Left(Cells(i, xx), 3) <> "c/o" Then
Cells(i, xx).Value = Cells(i, yy).Value
Cells(i, yy).Value = ""
End If
If Cells(i, zz).Value Like "*PO*" And Left(Cells(i, xx), 3) <> "c/o" Then
Cells(i, xx).Value = Cells(i, zz).Value
Cells(i, zz).Value = ""
ElseIf Cells(i, zz).Value Like "*PO*" And Left(Cells(i, xx), 3) = "c/o" Then
Cells(i, yy).Value = Cells(i, zz).Value
Cells(i, zz).Value = ""
End If
Next i
Application.ScreenUpdating = True
End Sub
Bookmarks