asked on

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

ExcelEO

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

bsharath

ASKER

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

ExcelEO

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

bsharath

ASKER

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

bsharath

ASKER

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

ExcelEO

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

bsharath

ASKER

Ok thanks
Can you please fix the above issues

Will need blanks handled at same time 1,000's of rows

ASKER CERTIFIED SOLUTION

ExcelEO

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

bsharath