If a cell contains a certain "word", then return todays date

[DarkoDeign2]

Hi,

I have been searching the web for a workable formula, but so far I haven't been able to find anything to make use of.

Cell AE2 can be blank, or contain one of three possible words: "Apple", "Car" or "Book".
In cell AG2 I would like to have a formula that returns "todays date" if cell AE2 contains the word "Apple". Furthermore I would like to have the date static, so it doesn't change over time.

Would appreciate if somebody could help me figuring this out.

 

[Joe4]

That is best done with VBA, as Excel formulas to return the current date use the TODAY() function, which is dynamic, which means it changes every day.
So it is best to use VBA to hard-code the current date so it doesn't change.

However, there are two ways to go about it:
1. If you want this to run on existing data in column AE, you would want to manually run the VBA code upon demand.
2. If you want, you could have VBA code that runs automatically as you enter data into column AE. This obviously only works for new data entry, not existing data.

Also, should we assume that you want this to run for all cells below AE2 (i.e. AE3, AE4, AE5, etc), and not just cell AE2?

Just let us know what option works for your situation, and we can help you write that VBA code.

 

[DarkoDeign2]

Hi Joe,

Thanks for your help.
The best alternative would be option 2, a running VBA code for any new inputs into column AE.
Yes there will be data in cell AE2 and below. Since I don't know how easy it is to have a code that scans cell AE2:AE1500? Will the file become heavy and sluggish if I have VBA codes running on 1500 lines? In this file I have multiple conditional formatting formulas running already, so far so good, no sluggishness yet
VBA is completly new territory for me so excuse my novise questions.

 

[Joe4]

Go to the sheet that you want to apply this to, right-click on the Sheet tab name at the bottom of the screen, select "View Code", and paste this code in the VB Editor window that pops up:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   See if any updates to specified range
    Set rng = Intersect(Range("AE2:AE1500"), Target)
    
'   Exit sub if no changes to watched range
    If rng Is Nothing Then Exit Sub
    
'   Loop through changed cells
    Application.EnableEvents = False
    For Each cell In rng
'       See if cell is set to "Apple"
        If cell.Value = "Apple" Then
'           Add date stamp to column AG of same row
            cell.Offset(0, 2).Value = Date
        End If
    Next cell
    Application.EnableEvents = True
    
End Sub

This VBA code will automatically run whenever you make updates to the range AE2:AE1500.

The code should not affect the performance of your workbook, even for 1500 cells.

 

[DarkoDeign2]

Hi Joe,

This works like a charm.
I have one issue, that the date shows up in fontstyle "Roboto" and fontsize 8 in the cell in column AG.
What can I do to have the fontstyle "Calibri" and fontsize 11 on the dates in column AG?

 

[Joe4]

Hi Joe,

This works like a charm.
I have one issue, that the date shows up in fontstyle "Roboto" and fontsize 8 in the cell in column AG.
What can I do to have the fontstyle "Calibri" and fontsize 11 on the dates in column AG?

The code is not changing the font at all. If you are seeing it in that format, it is because your workbook has already pre-formatted that column that way (try typing anything into any blank cell in AG and you will see this). Simply highlight the whole column AG and change it to whatever format you want, and anything this code writes to the column will be in that format.

 

[DarkoDeign2]

Hi,
Seems like my excel is a bit buggy... It works fine now.
Thanks for the tip.

 

[DarkoDeign2]

Hi,

I added two columns before Column AE. Now the script doesn't work eventhough I change the code
from: Set rng = Intersect(Range("AE2:AE1500"), Target)
To: Set rng = Intersect(Range("AG2:AG1500"), Target)





Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim cell As Range

' See if any updates to specified range
Set rng = Intersect(Range("AE2:AE1500"), Target)

' Exit sub if no changes to watched range
If rng Is Nothing Then Exit Sub

' Loop through changed cells
Application.EnableEvents = False
For Each cell In rng
' See if cell is set to "Apple"
If cell.Value = "Apple" Then
' Add date stamp to column AG of same row
cell.Offset(0, 2).Value = Date
End If
Next cell
Application.EnableEvents = True

End Sub


What I am doing wrong?

 

[Joe4]

Have events been disabled?

Try manually running this procedure to re-enable them:

Sub ReEnableEvents()
    Application.EnableEvents = True
End Sub

and then see if it works.

 

[DarkoDeign2]

Oh, now it works again... I don't know I did..