Thank You Simon Llyod for you code
Credits :In Alphabetical Order
abousetta,Simon,tarquinious
'Coded by Simon Llyod
Sub Outcomes()
Dim rng As Range, MyCell As Range, rng1 As Range, oCell As Range
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Range("AA1").Value = "Outcome"
'Range("AB1").Value = "Remarks"
Range("AA2:AB" & Range("AA" & Rows.Count).End(xlUp).Row).ClearContents
Set rng1 = Range("E2:I" & Range("I" & Rows.Count).End(xlUp).Row)
Range("AA1").Value = "Outcome"
Range("AB1").Value = "Remarks"
For Each oCell In rng1
If oCell > 0 Then
Range("AA" & oCell.Row) = Range("AA" & oCell.Row) & "," & Cells(1, oCell.Column).Value
End If
Next oCell
For Each oCell In Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
oCell.Value = Right(oCell.Value, Len(oCell) - 1)
oCell.Value = Left(oCell.Value, Len(oCell) - 1)
Next oCell
Set rng = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
Select Case MyCell.Offset(0, 23)
Case "C,B2,B3", "B1,B3"
MyCell.Offset(0, 24).Value = "Remind,Escalate"
Case "U,B1,B3", "U,C,B1,B2,B3"
MyCell.Offset(0, 24).Value = "send ,Remind,Escalate"
Case "u"
MyCell.Offset(0, 24).Value = "Send"
Case "B1", "B1,B2"
MyCell.Offset(0, 24).Value = "Remind"
Case "B1,B2,B3"
MyCell.Offset(0, 24).Value = "Escalate"
Case "C"
MyCell.Offset(0, 24).Value = "No Outcome"
End Select
Next MyCell
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Bookmarks