I am trying to append this code that works great down to the ' Comment lines
where I am trying to get the (Comments").value to set to blank("") if the
string has only one item, otherwise if more than one then the
builtindocument.comments field is set to the full string.

Previous posts helped solve the problem at the end with the replace to
remove the extra commas to clean up the string list. Not sure of the best
approach to take with all the variables going on. . . I've left my attempts
commented out to help follow the logic but there may be something better.

Any help is most appreciated as this will save many hours of effort to fix
manually as I use it to process all the files (4000+) in a data directory.



Public Sub FillFilePropsComments() '(Optional control As IRibbonControl)

Dim ws As Worksheet
Dim Strlist() As String ' list for permit numbers
Dim ptr As Integer ' pointer/ counter for strList
Dim PermitNumber As Variant
Dim DupFound As Boolean
Dim StrComment As String
Dim PropAuthor As String

ptr = 0 ' init pointer - currently there are zero permit numbers in list
ReDim Strlist(1 To Sheets.Count) ' init size of list, should not be more
Permits than sheets

For Each ws In Worksheets
PermitNumber = GetPermitNumber(ws) ' get the permit number
DupFound = False ' assume it is not already in list
For i = ptr To 1 Step -1 ' start from back of list, see if it
is a dup
If PermitNumber = Strlist(i) Then
DupFound = True
Exit For
End If
Next i
If Not DupFound Then ' it is not already in list
ptr = ptr + 1 ' make a place for it in the list by pointing to
next empty slot
Strlist(ptr) = PermitNumber ' store new permit number
End If
Next ws

ReDim Preserve Strlist(1 To ptr) ' resize list to number of permits
QuickSort Strlist, LBound(Strlist), UBound(Strlist) ' sort the list

For i = 1 To ptr ' get the list into one long string
StrComment = StrComment & Strlist(i) & ", "
Next i


StrComment = myStr

myStr = Replace(myStr, ",", " ")
myStr = Application.Trim(myStr)
myStr = Replace(myStr, " ", ", ")

myStr = StrComment

' 'ReDim Preserve StrComment(1 To ptr)

' If StrComment(ptr).Count = (1) Then
' StrComment = ""
' ElseIf StrComment(i).Count (1) Then
' StrComment

` ' store the string in the FileComments Property box
ActiveWorkbook.BuiltinDocumentProperties("Comments ").Value = StrComment