Need a macro for the following [Closed]

Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,

i am have a set of numbers( indicating the product serial number) in rows having comments which include some text + date of manufacturing .
i need to get the greatest of all the dates too end of that row .

condition : 1.n numbers of rows can be there
2. text in comments is redundant.

also can i copy this date which i have found with above macro to a "column " in another sheet

2 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
767
Could you please upload a sample file with sample data etc on some shared site like https://authentification.site , http://wikisend.com/ , http://www.editgrid.com etc and post back here the link to allow better understanding of how it is now and how you foresee.
thnks for the reply .
here have added a sample sheet .
thnks for the reply
here have added the sample sheet
https://authentification.site/files/22739205/samplesheet.xls
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
767
Try this function. It will look at the comments in a range being defined.

The dates has to be last thing on each line of a comments. example comment
This is my comment 2004-10-01


If a comment is a multi-paragraph comments, then each date should be at the end of each paragraph to be considered. A date in between the text of the comment is ignored. example comment
This is first line of comment 2004-10-01
this is the 2nd line of comment 2004-10-01



Assumptions:

1. Dates are at the end of the line of the comment.
2. The dates are separated by the text of comments by a space
3. The last characters of the comments, if not dates, cannot be confused as date, example 2004, Jan-2004, 01-04 etc

If you want to find the maximum date in the comments in the range J10:M10, you would be calling this function as

=getDate("J10:M10")
or

=getDate("DC!J10:M10")
where DC is the sheet name



Function getDate(sMyRange As String)
Dim sCommentText As String ' comments in the cell
Dim sRemainderComment As String '
Dim Cell As Range 'cell being processed
Dim myRange As Range 'range to be processed
Dim MaxDate As String 'max date found
Dim vPos As Variant ' variable to hold position of " " which is our delimiter
Dim sCandidateText As String 'partial string to be checked for being a date

    MaxDate = ""
        
    Set myRange = Range(sMyRange)

    For Each Cell In myRange
        
        sCommentText = ""
        sCandidateText = ""
        sRemainderComment = ""
        
        On Error Resume Next
        
            sCommentText = Cell.Comment.Text
            sCommentText = Trim(sCommentText)
            
        On Error GoTo 0
        
        sRemainderComment = sCommentText
        Do Until (sRemainderComment = "")
             
            vPos = InStrRev(sRemainderComment, Chr(10))
            
            If ((vPos > 0) And (vPos < Len(sRemainderComment))) Then
                
                sCandidateText = Mid(sRemainderComment, vPos + 1)
                sCandidateText = Trim(sCandidateText)
                
                sRemainderComment = Left(sRemainderComment, vPos - 1)
                sRemainderComment = Trim(sRemainderComment)
             
            ElseIf (vPos > 0) Then
            
                sCandidateText = ""
                
                sRemainderComment = Left(sRemainderComment, vPos - 1)
                sRemainderComment = Trim(sRemainderComment)
            
            Else
            
                sCandidateText = sRemainderComment
                sRemainderComment = ""
                
            End If
        
        
        
            vPos = InStrRev(sCandidateText, " ")
            
            If ((vPos > 0) And (vPos < Len(sCandidateText))) Then
                
                sCandidateText = Mid(sCandidateText, vPos + 1)
                sCandidateText = Trim(sCandidateText)
                        
            Else
            
                sCandidateText = sCandidateText
                
            End If
        
                    
            If ((IsDate(sCandidateText)) And (Not IsNumeric(sCandidateText))) Then
            
                If MaxDate = "" Then MaxDate = sCandidateText
                    
                If (CDate(sCandidateText) > CDate(MaxDate)) Then MaxDate = sCandidateText
            
            End If
        
        Loop
        
    Next Cell
    
    Set Cell = Nothing
    Set myRange = Nothing

    getDate = MaxDate
    
End Function

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!