PDA

View Full Version : VBA for time display



achin
06-18-2008, 07:28 PM
I have wrote the following VBA code for excel.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("C:C").Column And Cell = 1 Then
Cells(.Row, "D").Value = Int(Now)
Cells(.Row, "D").NumberFormat = "dd.mm.yyyy"
End If
End With
Next Cell

I wanna add one more function where if C:C is not equal to 1, (.Row,"D") will be an empty cell.
So, I've changed the code to below:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("C:C").Column And Cell = 1 Then
Cells(.Row, "D").Value = Int(Now)
Cells(.Row, "D").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "D").Value = ""
End If
End With
Next Cell

But it seems to looping for quite some times.. abt 15-30 seconds.
Can anybody tell me how should i amend the code to get rid of looping?

mikerickson
06-18-2008, 09:55 PM
Looping through all of Target is un-nessesary. Cascading the Change event can take time.Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim oneCell As Range
Application.EnableEvents = False
On Error GoTo HaltSub
For Each oneCell In Application.Intersect(Target, Range("C:C"))
With oneCell
.Offset(0, 1).Value = IIf(.Value = 1, Date, vbNullString)
.Offset(0, 1).NumberFormat = "dd.mm.yyyy"
End With
Next oneCell
HaltSub:
On Error GoTo 0
Application.EnableEvents = True
End Sub

achin
06-18-2008, 11:06 PM
Thanks mike!
Actually, the codes not only play on C:C, but E:E, G:G, I:I and so one..
I was trying to copy and modify from your codes, but it doesn't work except C:C.

achin
06-18-2008, 11:22 PM
I've got the solution.
To stop the looping, all we have to do is inluded the Application.EnableEvents

Thanks again! :-)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
Application.EnableEvents = False
With Cell
If .Column = Range("C:C").Column And Cell = 1 Then
Cells(.Row, "D").Value = Int(Now)
Cells(.Row, "D").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "D").Value = ""
End If
End With
Next Cell
Application.EnableEvents = True
End Sub

mikerickson
06-18-2008, 11:40 PM
I'm glad you found your solution.
To modify my code to include larger ranges:
For Each oneCell In Application.Intersect(Target, Range("C:C,E:E,G:G"))

achin
06-24-2008, 01:23 AM
It's not work correctly.
When 100% is input on A1, date will auto display on B1.
But date at B1 disappeared when 100% is input on C1 and D1 appeared with date.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
Application.EnableEvents = False

With Cell
If .Column = Range("A:A").Column And Cell = 1 Then
Cells(.Row, "B").Value = Int(Now)
Cells(.Row, "B").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "B").Value = ""
End If
End With
Next Cell

With Cell
If .Column = Range("C:C").Column And Cell = 1 Then
Cells(.Row, "D").Value = Int(Now)
Cells(.Row, "D").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "D").Value = ""
End If
End With
Next Cell

For Each Cell In Target
With Cell
If .Column = Range("E:E").Column And Cell = 1 Then
Cells(.Row, "F").Value = Int(Now)
Cells(.Row, "F").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "F").Value = ""
End If
End With
Next Cell

For Each Cell In Target
With Cell
If .Column = Range("G:G").Column And Cell = 1 Then
Cells(.Row, "H").Value = Int(Now)
Cells(.Row, "H").NumberFormat = "dd.mm.yyyy"
Else
Cells(.Row, "H").Value = ""
End If
End With
Next Cell



Application.EnableEvents = True
End Sub

Bob Phillips
06-24-2008, 01:32 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range

Application.EnableEvents = False

With Target

If .Count = 1 Then

If .Column = 1 Or .Column = 3 Then

If .Value = 1 Then
.Offset(0, 1).Value = Int(Now)
.Offset(0, 1).NumberFormat = "dd.mm.yyyy"
Else
.Offset(0, 1).Value = ""
End If
End If
End If
End With

Application.EnableEvents = True
End Sub

achin
06-24-2008, 07:38 PM
thanks, XLD!
It's works!