List Multiple Results from “If/Then” Macro in One Cell

[pashutterbug]

Hi all--new user here

I currently have an Excel macro (Excel 2010/Windows 7)that allows me to assign a category in a blank column based on data in the preceding column. (Actual report structure below—dummy data)

Received time	Sender	Sender Classification	Recipient	Recipient Classifications
1/1/2017 23:13	Doe,John [ABC Company]	MyCompany	DEF Operations; KLM Company	DEF Ops, Your Company
1/2/2017 5:02	DEF Operations	DEF Ops	Smith,Bob[DEF Company]
1/2/2017 5:02	DEF Operations	DEF Ops	Doe,John [ABC Company]
1/2/2017 9:11	ABC License Partner	Business Partner	DEF Operations	DEF Operations
1/2/2017 9:12	XYZ License Partner	Business Partner	DEF Operations	DEF Operations

<tbody>
</tbody>

The macro is working well for me, however, I was wondering if there was a way to list multiple classifications in one cell. For instance, in the first red text cell above there are 2 If/Then criteria—currently my macro will list only the 1^st one in the macro. I would like it to list all classifications, each separated by a comma (as shown).

Dim LastDataRow As Long
Dim c As Range
 
LastDataRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row   
 
For  J = 2 To 6 Step 2
 
    For  i  =  2 To LastDataRow  
        Set c = Cells(i, J)  
       
        If InStr(c, "ABC  License Partner") Or _
           InStr(c, "XYZ License Partner") Then
                c.Offset(0, 1) = "Business Partner"
        ElseIf InStr(c, “DEF Operations”) Then
                  c.Offset(0, 1) = “DEF Ops”
        ElseIf InStr(c, "report type") Or _
           InStr(c, "seriousness") Or _
           InStr(c, "Protocol") Then
                c.Offset(0, 1) = "Case query"
        ElseIf InStr(c, "ABC Company") Then
                c.Offset(0, 1) = "MyCompany"
        ElseIf InStr(c, “KLM Company”) Then
                  c.Offset(0, 1) = “Your Company”
              
        End If
   
    Next i
Next J
 
Set c = Nothing
 
End Sub

Kind regards,
Kim

 

[Roderick_E]

Instead of writing the result immediately to the cell, create a string that appends...
So instead of

c.Offset(0, 1) = "MyCompany"

if trim(classstr)=""
classstr = "MyCompany"
else
classstr = classstr & " " & "MyCompany"
endif
c.Offset(0, 1) = classstr

You have to reset the classstr to "" after each loop
classstr = ""