Is there a way to replace a date by inserting a Quarter

[chamdan]

Hi,

I have a worksheet where in column 6 or E, I want when the user enter a date to automatically be replaced by a Quarter.see the image enclosed. I know that the formula to calculate the quarter is as follow but how to integrate the quarter into a cell after the entering a date into the same cell?
="Q"&INT((MONTH(E11)+2)/3)
Your help would be appreciated.

Thanks in advance.

Chuck

[Rudi]

Try this:

Right click on the sheet tab of the worksheet that contains the data.
Choose View Code
Paste the code below onto the module and give it a try by typing a date into cell E11...

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("E11")) Is Nothing Then
        If IsDate(Target.Value) Then
            Target.Value = "Q" & CInt((Month(Target.Value) + 2) / 3)
        End If
    End If
    Application.EnableEvents = True
End Sub

[chamdan]

Hi Rudi,

Thanks for your prompt reply but what if the row changes since there will be many rows. Would you change the following:

Code: Select all

If Not Intersect(Target, Range("E11")) Is Nothing Then

by

Code: Select all

If Not Intersect(Target, Range("E" & Target.Row)) Is Nothing Then

I made that amendment and it worked.


Chuck

[Rudi]

Well done...
(You are becoming a skilled programmer)

[HansV]

If there is a chance that you enter a date in multiple cells at once (for example by confirming a value with Ctrl+Enter), the following version will handle that:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cel As Range
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Application.EnableEvents = False
        For Each cel In Intersect(Target, Range("E:E"))
            If IsDate(cel.Value) Then
                cel.Value = "Q" & (Month(cel.Value) + 2) \ 3
            End If
        Next cel
        Application.EnableEvents = True
    End If
End Sub

[chamdan]

Thanks Hans,

The same column but each time in a different row.

Is it possible to have the intersect start at a particular row and column? for instance see the following:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Not Intersect(Target, Range("E" & Target.Row & ":" & "E")) Is Nothing Then
    Application.EnableEvents = False
    For Each cel In Intersect(Target, Range("E" & Target.Row & ":" & "E"))
        If IsDate(cel.Value) Then
           cel.Value = "Q" & (Month(cel.Value) + 2) \ 3
        End If
    Next cel
    Application.EnableEvents = True
End If
End Sub

Just wondering whether this would work? I will give this a try and will let you know.


Chuck

[HansV]

If you want to start at row 5, for example, you'd have to use Range("E5:E" & Rows.Count):

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cel As Range
    If Not Intersect(Target, Range("E5:E" & Rows.Count)) Is Nothing Then
        Application.EnableEvents = False
        For Each cel In Intersect(Target, Range("E5:E" & Rows.Count))
            If IsDate(cel.Value) Then
                cel.Value = "Q" & (Month(cel.Value) + 2) \ 3
            End If
        Next cel
        Application.EnableEvents = True
    End If
End Sub

[chamdan]

Hans I Tried yours and it worked perfectly, mine did not work while debugging an error happened at the following line due to the Target.Row



Chuck