PDA

View Full Version : [SOLVED] Automating Date Entry



sfshah
02-23-2014, 08:35 AM
I have come across the following Code to automate the date entry in the same row in column E if any cell in the range name "Codes" (range F11:F30) is fed with any data.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("CODES")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("E" & Value.Row).Value = Now
End If
Next Value
End If
End Sub

The name "Codes" refer to cells F11:F30. As per this code, the current date entry will appear in column "E" in cell E11 if anything is written in cell F11.

I want to modify this code in such a way that instead of Column E, a column on the left of Range "Codes" is fed with a date when the reference to the range name "Codes" is changed to say "B11:B30", so that the date will appear in A11 if some data is fed in B11.

After that I want to convert this as an Add in so that it can be used in many files, as I have plenty of such files.

I shall be thankful for the assistance.
sfshah

Bob Phillips
02-23-2014, 09:37 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

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

For Each cell In Target

If cell.Value <> "" Then

cell.Offset(0, -1).Value = Now
End If
Next Value
End If
End Sub

p45cal
02-23-2014, 10:39 AM
Since the code loops through cells, it implies that there could be more than one cell changed at a time, as in cut-and-pasting a block of cells, or Ctrl+Entering values in one go, or even via other vba code.
With the current code, because it loops through all the cells in Target, that could include cells not within the Codes named range (even if the two ranges overlap). So if the copied range included cells above and/or below the Codes range, or was more than one column wide, you'll get date/time stamps where you don't want them. Looping through the range resulting from Intersect(Target, Range("CODES")) might be a little more robust:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellsChanged As Range, cll As Range
Set CellsChanged = Intersect(Target, Range("CODES"))
If Not CellsChanged Is Nothing Then
For Each cll In CellsChanged
If cll <> "" Then
cll.Offset(0, -1).Value = Now
End If
Next cll
End If
End Sub
Let's hope the Codes range is never in column A.

snb
02-23-2014, 01:13 PM
Private Sub Worksheet_Change(ByVal Target As Range)
application.enableevents=false

If Not Intersect(Target, Range("CODES")) Is Nothing Then target.specialcells(2).offset(,-1)=now

application.enableevents=true
End Sub

sfshah
02-23-2014, 08:53 PM
Thanks xld for your help,
Thanks p45cal,
Your code works perfectly.
Can you help me convert this into an Addin, so that it is available in all excel files where range name "CODES" is present; because I use Excel 2011 for mac, many of my files are saved as xlsx.

I am attaching the file with your code, kindly help me prepare an addin file.
Thanks once again, Good day.
sfshah

sfshah
02-24-2014, 07:18 AM
Thanks xld for your help,
Thanks p45cal,
Your code works perfectly.
Can you help me convert this into an Addin, so that it is available in all excel files where range name "CODES" is present; because I use Excel 2011 for mac, many of my files are saved as xlsx.

I am attaching the file with your code, kindly help me prepare an addin file.
Thanks once again, Good day.
sfshah

snb
02-24-2014, 01:12 PM
Please do not quote (especially not yourself !)

p45cal
02-25-2014, 06:15 AM
sfshah,
for me this add-in creation for event handling is exploration; I'm not an authority on the subject.
After doing some googling/research I've come up with something that works (at least seems to) here.
I'm not going to describe what I've done in detail, that would take too long, but I link to the addin (https://app.box.com/s/67chb1ie19ltjuzr9raf) as a tentative solution for you.
This is what's in the add-in: In a standard code module I have:
Public MySheetHandler As SheetChangeHandler

Sub Auto_Open()
Set MySheetHandler = New SheetChangeHandler
End Sub

In a class module called SheetChangeHandler I have:
Option Explicit
Private WithEvents App As Application

Private Sub Class_Initialize()
Set App = Application
End Sub

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Debug.Print "Changed"
On Error GoTo Finish
App.EnableEvents = False
Dim CellsChanged As Range, cll As Range
Set CellsChanged = Intersect(Source, Sh.Range("CODES"))
If Not CellsChanged Is Nothing Then
For Each cll In CellsChanged
If cll <> "" Then
cll.Offset(0, -1).Value = Now
End If
Next cll
End If

Finish:
App.EnableEvents = True
End Sub

(ripped off from:
http://stackoverflow.com/questions/858691/how-can-an-excel-add-in-respond-to-events-in-any-worksheet

Other sites I looked at:
http://www.cpearson.com/excel/AppEvent.aspx
http://www.cpearson.com/excel/createaddin.aspx
http://www.cpearson.com/excel/classes.aspx
http://www.pcreview.co.uk/forums/handle-sheetchange-event-add-t999424.html
http://www.ozgrid.com/forum/showthread.php?t=86776

and should things stop working this might be relevant:
http://www.mrexcel.com/forum/excel-questions/510033-unreliable-application-level-sheet-change-event.html )

p45cal
02-25-2014, 06:17 AM
snb, remember that doing a specialcells(2) on a single cell does it for the whole sheet…

sfshah
02-25-2014, 09:49 AM
Dear p45cal,
Thanks for the help. I am extremely thankful to you for your efforts to help me. The code works perfectly well. You are genius. Wish you all the best.
Thanks once again,
sfshah:hi: