capture date and data every time data changes

[Guest]

Hello,
I need your help again...! please!
I need to know what data a particular cell had at the end of each month.
These cells are not tied to a date so they cannot be filtered.
Can I somehow after the User enters new data in the cell and clicks Enter
automatically copy the figure to another Sheet under the corresponding
month?
e.g.,
On 9/10/04 User enters in Sheet1!C1 the amount of $20
on 10/10/04 user changes the same cell to $40
on 11/25/04 user changes the same cell to $60

I need to capture the amount, per month, on a separate sheet.
9/04 $20
10/04 $40
11/04 $60

Again, thanks to all for any help you can give me.

 

[Frank Kabel]

Hi
though this can be done using an event procedure (using the
worksheet_change ecvent) I don't recommend using it. Why not let the
user enter the date AND the amount

 

[Guest]

Why don't you recommend the worksheet_change event?

(I am working with a workbook developed by someone else and
adding date on those particular cells, at this point, is not an option)

 

[Myrna Larson]

Sounds to me like you don't have the right layout. If the user over-writes
data in C1, you have NO audit trail in case there's an error. I think it would
be better to enter all amounts AND dates, on another sheet. Then use formulas
to transfer whatever is needed to the sheet you are talking about now.

 

[Myrna Larson]

It sounds to me as though the workbook should be redesigned, along the lines
of what I mentioned in my previous reply.

 

[Guest]

I agree with you 100%, but again, I have to work with what I have.
My idea was to write a macro that when the user hits enter, it would also
record the data of the cells in question and stamp date them on another
sheet. Once I have the data with a date, I can manipulate it any way I want.
Can this be done? Can you help me write this macro?
Thanks, I really appreciate it.

 

[Myrna Larson]

Yes, but I need more information, specifically the layout of the sheet to
which the data (and the date) are to be transferred, e.g. to Sheet 2, next
available row, columns A and B...

 

[Myrna Larson]

Maybe this will get you started. The macro goes in the module for the
worksheet where the user is entering the data. If that's Sheet1, the module
name is also Sheet1. I've assumed it's to be copied to Sheet2.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long
If Target.Address = "$C$1" Then
With Worksheets("Sheet2")
R = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(R, 1).Resize(1, 2).Value = Array(Date, Target.Value)
End With
End If
End Sub

 

[Myrna Larson]

Here is some code that captures only the last entry for a given month. If the
year+month of the last pre-existing entry is the same as the current
year+month, that last data point will be overwritten.

Otherwise, the last pre-existing data point will be kept. That will happen
even if it's *later* than the current date. (The latter would happen only if
the computer clock had been set incorrectly in the past, or someone has
altered the data.)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim PrevEntry As Variant
Dim R As Long

If Target.Address = "$C$1" Then
With Worksheets("Sheet2")
R = .Cells(.Rows.Count, 1).End(xlUp).Row
PrevEntry = .Cells(R, 1).Value2

If IsEmpty(PrevEntry) Then
'use this row

ElseIf IsNumeric(PrevEntry) Then
If Format$(Date, "yyyymm") <> Format$(PrevEntry, "yyyymm") Then
R = R + 1
End If

Else 'text, boolean, error?
R = R + 1

End If

.Cells(R, 1).Resize(1, 2).Value = Array(Date, Target.Value)

End With
End If
End Sub

 

[Guest]

Wow! That's one heck of a code! Thanks! It works fantastic!
One last thing. How do I add additional target cells to be placed in
subsequent columns?

 

[Myrna Larson]

Can you give more more details? Do you mean that the macro is to be triggered
by entries in some other cells, and different data is to be placed in a
(different or same?) list on sheet2?

I need to know (a) a list of cells that trigger the macro, (b) for each such
cell, where is the list on Sheet2, (c) for each such cell, what data is to be
entered on Sheet2

From the information you've given so far, I would probably use a Select Case
block to identify the target cell, something like

Select Case Target.Address
Case "$C$1"
'existing code goes here
Case "$D$1"
'new code needed here
Case "$E$1")
etc.

Assuming there are lots of cells, each with a different list on the 2nd sheet,
I would take the code that identifies the row to be filled and put it in a
separate sub, to avoid repeating that code with multiple different columns on
Sheet2.

 

[Myrna Larson]

So data from the other 20 cells will go to the right, columns C:V, using the
same logic, i.e. checking the data and overwriting the value if it's the same
month and year as the previous entry?

Do you need to know that date associated with each cell change? If so, you
would need to repeat the format that I set up - date, data - for each
variable.

 

[Guest]

In this particular case, there is only the need to track the latest date on
each moth. So the code that you have works perfect. It gives the date and
overwrites with the new figure, grouping monthly. And yes it will go from C:V
Thanks

 

[Myrna Larson]

Have you figured out the code for yourself? You haven't told me what the
source cells are for data to be copied to columns C-V.

The macro needs a 20-case Select Case block unless there's some pattern to the
layout on Sheet1, such as C1 goes to column B, D1 to column C, E1 to column D,
or C2 goes to column C, C3 to column D, etc.

To complete the macro, details are needed, i.e.

C1 to column B
D8 to column C
A22 to column D, etc.

 

[Guest]

Yes, I (kind of) figured it out! Thanks! I really appreciate it.
There are two things though.
1) When I add the second Case it places #n/a on the next two columns
When I insert the 3rd Case, it inserts 2 more#n/a's for that case.
What am I doing wrong?
2) I need to identify the columns with the target cell names.
Case $C$1 should have its title in B1, Case $G$7
in D1, Case $F$27 in E1, etc.

Following is the code for the 2nd Case:

Case "$D$1"
If Target.Address = "$D$1" Then
With Worksheets("Sheet2")
R = .Cells(.Rows.Count, 1).End(xlUp).Row
PrevEntry = .Cells(R, 1).Value2

If IsEmpty(PrevEntry) Then
'use this row

ElseIf IsNumeric(PrevEntry) Then
If Format$(Date, "yyyymm") <> Format$(PrevEntry, "yyyymm") Then
R = R + 1
End If

Else

R = R + 1

End If

.Cells(R, 3).Resize(1, 4).Value = Array(Date, Target.Value)

End With
End If

 

[Myrna Larson]

You are getting the NA()s because you set the destination range to 4 columns
wide, but supply data only for the 1st and 2nd columns. And you don't want to
change the array statement to Array(Date,,,Target.Value) because that would
overwrite the entries in columns B and C with blanks.

I've been mulling over your problem.

Assuming the date needs to be listed only once, a more efficient approach
would be to, ahead of time, enter all of the column headers on Sheet2, row 1,
and the month-end dates in Sheet2, column A starting at A2. To do the latter,
in Sheet2!A2 put the first end-of-month date, say 1/31/2004. Then
Edit/Fill/Series, selecting Series in = columns, Type = Date, Date Unit =
Month, Step value = 1, Stop value (whatever you like)

In the code, you set up 2 arrays listing (a) the addresses of trigger cells on
Sheet1 and (b) the columns on Sheet2 where the data is to be copied. To add
more target cells, just add items to the 2 Array statements, marked with <<<

Then use the following "short and sweet" code in the Sheet1 module.

Do you like this better? I certainly do!

PS: If you want to correspond via email, put your email address in a reply.

Option Explicit
Option Base 0
Private EOM As Long

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Long
Dim AddressList As Variant
Dim DestColumns As Variant
Dim R As Long
Dim T As Range

AddressList = Array("$C$1", "$G$7", "$F$7")
DestColumns = Array(2, 4, 5) 'columns B, D, and E

Set T = Target.Cells(1) 'if multiple selection, use 1st cell

'look for the address in the list: if MATCH returns
'an error, it's not an address of interest
On Error Resume Next
A = Application.Match(T.Address, AddressList, 0)
If Err.Number <> 0 Then Exit Sub

A = A - 1 'adjust 1-based result of MATCH for 0-based array
If EOM = 0 Then SetEOM

With Worksheets("Sheet2")
R = Application.Match(EOM, .Columns(1), 0)
If Err.Number <> 0 Then
MsgBox "No entry for this month on Sheet2", vbOKOnly
Exit Sub
End If
.Cells(R, DestColumns(A)).Value = T.Value
End With

End Sub

Sub SetEOM()
Dim y As Long
Dim m As Long

y = Year(Date)
m = Month(Date)
EOM = CLng(DateSerial(y, m + 1, 0))
End Sub

 

[Guest]

This is much better.Thanks! It work great! Exactly what I needed!
With the worksheet_change function I know one of the draw backs
is that a change in a formula is not updated. Is there any kind of
trick that can circunvent this problem?

 

[Myrna Larson]

You could use a Worksheet_Calculate event.

To implement that, I would pull the "guts" out of the existing Change routine
and move it to a separate sub in a general module. Let's say we rename it
CheckOneCell.

The existing Change routine would be modified to just pass Target on to
CheckOneCell.

In the calculate routine, you would set up a For/Next loop to pass each range
in the list to CheckOneCell.

 

[Guest]

Thanks again. I'll work on it this weekend.
It would be great to contact you by e-mail. What's your address?

 

[Myrna Larson]

I got nailed by so much garbage due to my address being hijacked by the
spammers, I don't want to post it. If you post yours <g>, I'll contact you.

Otherwise, go to the Google advanced newsgroup search, and search for messages
from Myrna Larson in the date range 8/1/2003 through 8/10/2003. You'll find it
in messages I posted then.