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

I included all the code here because of all the named variables that might be
useful in developing a solution but am concerned only with the last block on
how to identify the strComment when it only has one item in it and then
delete it. I think now maybe the the Lbound(Strlist) is the value I'm
looking for to delete. I usually get the "subsccript out out range" error on
trials and error.

"owlnevada" wrote:

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

See my posts under this search "object variable or with block not set" which
answers the questions posed here.

"owlnevada" wrote:

I included all the code here because of all the named variables that might be
useful in developing a solution but am concerned only with the last block on
how to identify the strComment when it only has one item in it and then
delete it. I think now maybe the the Lbound(Strlist) is the value I'm
looking for to delete. I usually get the "subsccript out out range" error on
trials and error.

"owlnevada" wrote:

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