O
owlnevada
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 File>Comments Property box
ActiveWorkbook.BuiltinDocumentProperties("Comments").Value = StrComment
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 File>Comments Property box
ActiveWorkbook.BuiltinDocumentProperties("Comments").Value = StrComment