• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Date search in Text String

F

Frank Bacchus

Member
Hi:

I have a cell (A1) that contains text. At the end of this text there is a date in mm/dd/yyyy format. I would like to create a macro that would identify the date (at the end of the text) then subtract today's date from it. If the number of days is equal to or less than 10 day (or any other number I provide), I would like to flag cell B1 with "Y. Note the number of days can be a variable that I would supply to the macro, thus I can provide any number such as 5 or 8 or 30. But the calculation remains - today's date from date in cell A1 - if the number is days is equal or less than the 'provided' number of days, place a RED "Y" in cell B1. Can we doo this? See Example.

frank
 

Attachments

Hi Frank,

Assuming that your actual data is as you showed, with multiple lines in the cell, this macro will check A1.
Code: 
Sub CheckText()
Dim myLines As Variant
Dim myNum As Long
Dim myDate As Date
Dim i As Integer

On Error Resume Next
myNum = InputBox("How many days to check for?")
On Error GoTo 0
If myNum = 0 Then Exit Sub 'User aborted

myLines = Split(Range("A1").Value, Chr(10))

'Reset cell
Range("B1").ClearContents

'Check each line
For i = LBound(myLines) To UBound(myLines)
    myDate = DateValue(Right(myLines(i), 10))
   
    'Date needs to be in future, and within specified range
    If myDate > Date And myDate - Date <= myNum Then
        With Range("B1")
            .Value = "Y"
            .Font.Color = vbRed
            'If found, don't check anything else
            Exit Sub
        End With
    End If
Next i

End Sub
 
Try
Code: 
Sub test()
    Dim r As Range, m As Object, txt, NOD
    NOD = Application.InputBox("How many days?", Type:=1)
    If NOD = False Then Exit Sub
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d{1,2}/\d{1,2}/\d{4}(?=(\n|$))"
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            For Each m In .Execute(r.Value)
                r(, 2).Clear: r(, 2).VerticalAlignment = xlCenter
                If (Date < CDate(m)) * (CDate(m) - Date <= NOD) Then
                    r(, 2).Value = "Y": r(, 2).Font.Color = vbRed: Exit For
                End If
            Next
        Next
    End With
End Sub
 
jindon said:
Try
Code: 
Sub test()
    Dim r As Range, m As Object, txt, NOD
    NOD = Application.InputBox("How many days?", Type:=1)
    If NOD = False Then Exit Sub
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d{1,2}/\d{1,2}/\d{4}(?=(\n|$))"
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            For Each m In .Execute(r.Value)
                r(, 2).Clear: r(, 2).VerticalAlignment = xlCenter
                If (Date < CDate(m)) * (CDate(m) - Date <= NOD) Then
                    r(, 2).Value = "Y": r(, 2).Font.Color = vbRed: Exit For
                End If
            Next
        Next
    End With
End Sub
Click to expand...

Hi Jindon:

Thanks for the information. I have made some modifications to sheet and have been trying to change the code to accommodate the changes I made - without luck. Row 1 now has a heading so the data (text) starts in row 2. The column of the text is K and placing the "Y" is in column S. How do I make this modification ?

frank
 
Luke:

Thanks for the solution. I was testing it and in some conditions the flag (Red Y) was not being set. I am enclosing a new spreadsheet with new examples to show the code I am using. The datatext is in Column K and the "Y" indicator is going into Column S. Note that the first row is a "header" row.

There is a sheet called "Text Date" in the workbook that amplifies the examples and shows what the results would be.

Please let me know if you need any other information.

Thanks

frank


Assuming that your actual data is as you showed, with multiple lines in the cell, this macro will check A1.
Code: 
Sub CheckText()
Dim myLines As Variant
Dim myNum As Long
Dim myDate As Date
Dim i As Integer

On Error Resume Next
myNum = InputBox("How many days to check for?")
On Error GoTo 0
If myNum = 0 Then Exit Sub 'User aborted

myLines = Split(Range("A1").Value, Chr(10))

'Reset cell
Range("B1").ClearContents

'Check each line
For i = LBound(myLines) To UBound(myLines)
    myDate = DateValue(Right(myLines(i), 10))
 
    'Date needs to be in future, and within specified range
    If myDate > Date And myDate - Date <= myNum Then
        With Range("B1")
            .Value = "Y"
            .Font.Color = vbRed
            'If found, don't check anything else
            Exit Sub
        End With
    End If
Next i

End Sub
 

Attachments

Last edited by a moderator:
With the setup in your new sample sheet, change macro to this
Code: 
Sub CheckText()
Dim myLines As Variant
Dim myNum As Long
Dim myDate As Date
Dim i As Integer
Dim lastRow As Long
Dim rowCount As Long


On Error Resume Next
myNum = InputBox("How many days to check for?")
On Error GoTo 0
If myNum = 0 Then Exit Sub 'User aborted

'We're looking in col K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
Application.ScreenUpdating = False
For rowCount = 2 To lastRow

    myLines = Split(Cells(rowCount, "K").Value, Chr(10))
   
    'Reset cell
    Cells(rowCount, "S").ClearContents
   
    'Check each line
    For i = LBound(myLines) To UBound(myLines)
        myDate = DateValue(Right(myLines(i), 10))
       
        'Date needs to be in future, and within specified range
       If myDate > Date And myDate - Date <= myNum Then
            With Cells(rowCount, "S")
                .Value = "Y"
                .Font.Color = vbRed
                'If found, don't check anything else
               GoTo nextCell
            End With
        End If
    Next i
nextCell:
Next rowCount
Application.ScreenUpdating = True
End Sub
 
Frank Bacchus said:
Hi Jindon:

Thanks for the information. I have made some modifications to sheet and have been trying to change the code to accommodate the changes I made - without luck. Row 1 now has a heading so the data (text) starts in row 2. The column of the text is K and placing the "Y" is in column S. How do I make this modification ?

frank
Click to expand...
Code: 
Sub test()
    Dim r As Range, m As Object, txt, NOD
    NOD = Application.InputBox("How many days?", Type:=1)
    If NOD = False Then Exit Sub
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d{1,2}/\d{1,2}/\d{4}(?=(\n|$))"
        For Each r In Range("k1", Range("k" & Rows.Count).End(xlUp))
            For Each m In .Execute(r.Value)
                r(, 9).ClearContents
                If (Date < CDate(m)) * (CDate(m) - Date <= NOD) Then
                    r(, 9).Value = "Y": r(, 9).Font.Color = vbRed: Exit For
                End If
            Next
        Next
    End With
End Sub
 
Luke M said:
With the setup in your new sample sheet, change macro to this
Code: 
Sub CheckText()
Dim myLines As Variant
Dim myNum As Long
Dim myDate As Date
Dim i As Integer
Dim lastRow As Long
Dim rowCount As Long


On Error Resume Next
myNum = InputBox("How many days to check for?")
On Error GoTo 0
If myNum = 0 Then Exit Sub 'User aborted

'We're looking in col K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
Application.ScreenUpdating = False
For rowCount = 2 To lastRow

    myLines = Split(Cells(rowCount, "K").Value, Chr(10))
  
    'Reset cell
    Cells(rowCount, "S").ClearContents
  
    'Check each line
    For i = LBound(myLines) To UBound(myLines)
        myDate = DateValue(Right(myLines(i), 10))
      
        'Date needs to be in future, and within specified range
       If myDate > Date And myDate - Date <= myNum Then
            With Cells(rowCount, "S")
                .Value = "Y"
                .Font.Color = vbRed
                'If found, don't check anything else
               GoTo nextCell
            End With
        End If
    Next i
nextCell:
Next rowCount
Application.ScreenUpdating = True
End Sub
Click to expand...


Thanks again Luke,
I am getting an error with I believe is a "date checking" issue. I have attached the series of events including the actual data that the macro is operating on. Please see attached and again, thnks in advance.

frank
 

Attachments

Hi Frank. Since it looks like your actual data doesn't always have a date at the end of each line, I suggest using jindon's code. It's much better at finding dates and evaluating them.
 
Frank Bacchus said:
Hi Jindon:

Thanks for the information. I have made some modifications to sheet and have been trying to change the code to accommodate the changes I made - without luck. Row 1 now has a heading so the data (text) starts in row 2. The column of the text is K and placing the "Y" is in column S. How do I make this modification ?

frank
Click to expand...

04/08/2016: Hi Jindon:
I was testing your solution and I have some questions. In the attached sample, tow of the items didn't create the "Y" and I was wondering what could be the reason. Please look at the sample word doc. Thanks.

frank
 

Attachments

Frank Bacchus said:
Sorry. I was having problems uploading the file. I will send the sheet.
Click to expand...

Hi Jindon:
I have attached the sheet. I was testing your solution and I have some questions. In the attached sample, the "Y" flag was not created for the first and second rows. I was wondering what could be the reason. Please look at the sample attached sheet. Thanks.
 

Attachments

Frank Bacchus,

Sorry I was away.

Is it ">=", intead of "<="?
Code: 
If (Date < CDate(m)) * (CDate(m) - Date >= NOD) Then
?
 
You must log in or register to reply here.
Back
Top