U_Shrestha
04-01-2008, 08:36 AM
Hi,
Can someone please help me with following two things:
1) Change the range (Set rg = Range("A2:K5001") to dynamic range.
(Only the rows increase)
2) Combine both the codes into one.
Thanks.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range, rgRow As Range
On Error GoTo ExitHere
Set rg = Range("A2:K5001")
If Intersect(rg, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rgRow In Intersect(Target, rg).Rows
Cells(rgRow.Row, "L") = Now()
Next rgRow
ExitHere:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'check cells for desired format to trigger the calendarfrm.show routine
'otherwise exit the sub
Dim DateFormats, DF
DateFormats = Array("m/d/yy;@", "mmmm d yyyy")
For Each DF In DateFormats
If DF = Target.NumberFormat Then
If CalendarFrm3.HelpLabel.Caption <> "" Then
CalendarFrm3.Height = 191 + CalendarFrm.HelpLabel.Height
Else: CalendarFrm3.Height = 191
CalendarFrm3.Show
End If
End If
Next
End Sub
Can someone please help me with following two things:
1) Change the range (Set rg = Range("A2:K5001") to dynamic range.
(Only the rows increase)
2) Combine both the codes into one.
Thanks.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range, rgRow As Range
On Error GoTo ExitHere
Set rg = Range("A2:K5001")
If Intersect(rg, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rgRow In Intersect(Target, rg).Rows
Cells(rgRow.Row, "L") = Now()
Next rgRow
ExitHere:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'check cells for desired format to trigger the calendarfrm.show routine
'otherwise exit the sub
Dim DateFormats, DF
DateFormats = Array("m/d/yy;@", "mmmm d yyyy")
For Each DF In DateFormats
If DF = Target.NumberFormat Then
If CalendarFrm3.HelpLabel.Caption <> "" Then
CalendarFrm3.Height = 191 + CalendarFrm.HelpLabel.Height
Else: CalendarFrm3.Height = 191
CalendarFrm3.Show
End If
End If
Next
End Sub