Solved: Problem in Month days Calculation

[jammer6_9]

I am having a worksheet of Expiration Checklist.

Column A is Item Name
Column B is Shelf Life ( eg. 4 months )
Column C is Production Date ( eg. 5-May-2008 )
Column D is Expiration Date which I calculated as

=Production Date + (30.5 * 4) ' 30.5 as an Average days in a month.

which give me result of 4-Sep-2008 expiration date.

wherein it differ in the actual Case Packaging as follows which I need my worksheet calculation result regardless of the number of days in a month;

Production Date - 5-May-2008
Expiration Date - 5-Sep-2008

[Bob Phillips]

=DATE(YEAR(C5),MONTH(C5)+B5,DAY(C5))

but what do you want to do for 31st May?

[jammer6_9]

So far my query is solved xld... :bow: I just dont know for now what about the 31st... :bug:


=DATE(YEAR(C5),MONTH(C5)+B5,DAY(C5))

but what do you want to do for 31st May?

[Bob Phillips]

It will come out as 1st Oct because there is no 31st Sep.

[jammer6_9]

My concern on the worksheet is to show date base on packaging at least and will not show any expired items OR can show earlier expiration date.

As I am planning to put restriction like;


Dim rng As Range

Set rng = Sheet1.Range("C14:C100")

If ActiveCell.Value = 'here I want to put the condition like if user entered a date thatt is equal to 29th , 30th or 31st then result will be 28th max...

End If

[Bob Phillips]

Dim rng As Range

Set rng = Sheet1.Range("C14:C100")

With ActiveCell
If Day(.Value) > 28 Then
.Value = .Value - Day(.Value) + 28
End If
End With

[jammer6_9]

I am trying to change ActiveCell to Range so that I can put the code in Worksheet_SelectionChange Event but I am not successful in doing it and having "Type Mismatch" pointing to this section ---> If Day(.Value) > 28 Then




Dim rng As Range

Set rng = Sheet1.Range("C14:C100")

With ActiveCell
If Day(.Value) > 28 Then
.Value = .Value - Day(.Value) + 28
End If
End With

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error GoTo ws_exit

Application.EnableEvents = False

Set rng = Sheet1.Range("C14:C100")

If Not Intersect(Target, rng) Is Nothing Then
With Target
If Day(.Value) > 28 Then
.Value = .Value - Day(.Value) + 28
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[jammer6_9]

Thnks xld... I come up with almost the same code... Not better than your code but it works...


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
With Target

If Day(.Value) > 28 Then
.Value = .Value - Day(.Value) + 28

End If

End With
End Sub