We help IT Professionals succeed at work.

# Code editing needed

on
Hi all,

Got the below code from
ExcelEO
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
``````
Sample.xls
Comment
Watch Question

## View Solution Only

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

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.

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

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.

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

Commented:
Thanks

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

Samplev3.xls

Commented:
Thanks a lot its perfect