We help IT Professionals succeed at work.

Code editing needed

Hi all,

Got the below code from
ExcelEO
i need a addition
When script run need a comment created in sheet 3 software cell which gets the emp Id's that has this software as in the file. Column "D"

So each software has a comment and within it all emp id's one in each line or with a coma
Regards
Sub CreateNewReport()
Worksheets("Sheet1").Activate

Dim Product()
ReDim Product(0)

For r = 2 To 10
    
    flag = 0
    For rr = 1 To UBound(Product, 1)
        If Product(rr) = Cells(r, 6) Then
            flag = 1
            Exit For
        End If
    Next rr
    If flag = 0 Then
        ReDim Preserve Product(UBound(Product, 1) + 1)
        ndex = ndex + 1
    
        Product(ndex) = Cells(r, 6)
        
    End If
Next r

Dim SummaryProd()
ReDim SummaryProd(1, 0)



For r = 1 To UBound(Product, 1)
    ndx = ndx + 1
    Worksheets("Sheet3").Cells(ndx, 1) = Product(r)
    
    ReDim SummaryProd(1, 0)
    For rr = 2 To 10
    If Worksheets("Sheet1").Cells(rr, 6) = Product(r) Then
        a = getSubText(Worksheets("Sheet1").Cells(rr, 11))
        
        h = h + UBound(a)
        
        For p = 1 To UBound(a, 1)
        
            flag = 0
            For t = 1 To UBound(SummaryProd, 2)
                
                If SummaryProd(0, t) <> a(p) Then
                    
                Else
                   flag = 1
                   SummaryProd(1, t) = Str(Val(SummaryProd(1, t)) + 1)
                   o = o + 1
                End If
                

                                
            Next t
            
                If flag = 0 Then
                    ReDim Preserve SummaryProd(1, UBound(SummaryProd, 2) + 1)
                    SummaryProd(1, UBound(SummaryProd, 2)) = Str( _
                                                                    Val( _
                                                                    SummaryProd(1, UBound(SummaryProd, 2)) _
                                                                    ) + 1)
                    SummaryProd(0, UBound(SummaryProd, 2)) = a(p)
                    o = o + 1
                Else
                    flag = 0
                End If
        Next p
        

        
    End If
    Next rr
    g = 1
 
    For tt = 1 To UBound(SummaryProd, 2)
    
        
        Worksheets("Sheet3").Cells(ndx, 2) = SummaryProd(0, tt)
        Worksheets("Sheet3").Cells(ndx, 3) = SummaryProd(1, tt)
        ndx = ndx + 1
    Next tt
Next r

    g = 1
       
        
    

End Sub

Function getSubText(nString)

    Dim outString()
    ReDim outString(0)
    For I = 1 To Len(nString)
        If Mid(nString, I, 1) <> Chr(44) And Mid(nString, I, 1) <> Chr(10) Then
            conc = conc & Mid(nString, I, 1)
        Else
        
            ReDim Preserve outString(UBound(outString, 1) + 1)
            outString(UBound(outString, 1)) = Trim(conc)
            conc = ""
            
        End If
        
        
    Next I
            ReDim Preserve outString(UBound(outString, 1) + 1)
            outString(UBound(outString, 1)) = Trim(conc)
            
    getSubText = (outString)
    
End Function

Open in new window

Sample.xls
Comment
Watch Question

Commented:
I am sorry I did not understand your question exactly but here is my attempt.  
Samplev2.xls

Author

Commented:
Sorry that i was not clear

What i want is.

Say SQL is present in 4 products that report we got it. i want to know which emp id's have it

Create a comment in the software cell and place the emp id's within it
Else In a new colum can place the emp id's

Commented:
Try to run the revised code that in the excel file attached from my previous comment.  I think it does what you need.

Author

Commented:
I check and it does but some are missing

Say one software when i search shows 4 times and in the sheet 3 get it 2 or 3 emp id';s are only seen

Author

Commented:
Also
I have the sheet 1 with 1000's of rows.
I changed this line
For r = 2 To 1000
But does not help

Also

Some rows can be filled but the "Software List" column "K" can be blank
The script does not run in such case. Can we run and also say "Blank" and total

Commented:
I think that's because the same employee owns it twice in my mock list.  Otherwise it doesn't do that.

Author

Commented:
Ok thanks
Can you please fix the above issues

Will need blanks handled at same time 1,000's of rows
Commented:
I am sorry.  I will have to let you figure out the rest.  This is beyond my time allowance.

I think you are almost there.  You can easily make those modifications.

Take care

Author

Commented:
Thanks

Commented:
Here you go.  I think you can give me by points now. :)

Samplev3.xls

Author

Commented:
Thanks a lot its perfect

Explore More ContentExplore courses, solutions, and other research materials related to this topic.