PDA

View Full Version : [SOLVED] Need Help with a Change Event



wnazzaro
06-01-2005, 08:06 AM
I have a Private Sub Worksheet_Change that (when it works) will add numbers to Quarter columns based on the date that has just changed. However, Target.Value contains the old date, not the one that has changed. I need the Target to update to the new date before the sub is run.

As always, all and any help is appreciated.
Bill

Bob Phillips
06-01-2005, 08:15 AM
I have a Private Sub Worksheet_Change that (when it works) will add numbers to Quarter columns based on the date that has just changed. However, Target.Value contains the old date, not the one that has changed. I need the Target to update to the new date before the sub is run.

Target.Value passes the new value, not the old.

Share the code so we can see.

wnazzaro
06-01-2005, 08:19 AM
This also seems to run 2 to 3 times. And it never updates the cell.
I'm running Excel 2002.


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ws_exit:
'No need to run this if the Header row is changed.
If Target.Row = 1 Then
Application.EnableEvents = True
Exit Sub
End If
Dim StartDate As Date, EndDate As Date
Dim Output As String, PatCol As Variant
Dim CurCol As Variant, EndCol As Variant
Dim FPFVCol As Variant, LPLVCol As Variant
Dim Patients As Integer, i As Integer
Dim QStartCol As Variant, QEndCol As Variant
Dim cell As Range
'Which column is the FPFV date in?
FPFVCol = ActiveSheet.Range("A1:IV1").Find("FPFV").Address(ReferenceStyle:=xlR1C1)
FPFVCol = Right(FPFVCol, Len(FPFVCol) - InStrRev(FPFVCol, "C"))
'Which column is the LPLV date in?
LPLVCol = ActiveSheet.Range("A1:IV1").Find("LPLV").Address(ReferenceStyle:=xlR1C1)
LPLVCol = Right(LPLVCol, Len(LPLVCol) - InStrRev(LPLVCol, "C"))
If Target.Column <= LPLVCol Then
If Target.Column = FPFVCol Then
If Cells(CInt(Target.Row), CInt(LPLVCol)) = IsEmpty(Empty) Then
Application.EnableEvents = True
Exit Sub
Else
StartDate = Target.Value
EndDate = Cells(CInt(Target.Row), CInt(LPLVCol))
End If
ElseIf Target.Column = LPLVCol Then
If Cells(Target.Row, FPFVCol) = IsEmpty(Empty) Then
Application.EnableEvents = True
Exit Sub
Else
EndDate = Target.Value
StartDate = Cells(Target.Row, FPFVCol)
End If
Else
Application.EnableEvents = True
Exit Sub
End If
End If
PatCol = ActiveSheet.Range("A1:IV1").Find("Patients").Address(ReferenceStyle:=xlR1C1)
PatCol = Right(PatCol, Len(PatCol) - InStrRev(PatCol, "C"))
Patients = Cells(CInt(Target.Row), CInt(PatCol))
If Patients = 0 Then
MsgBox "You need to add the number of patients.", vbInformation Or vbOKOnly, _
"Zero Patients"
Application.EnableEvents = True
Exit Sub
End If
Dim Q1 As Integer, Q2 As Integer, Q3 As Integer, Q4 As Integer
Q1 = 3
Q2 = 6
Q3 = 9
Q4 = 12
'I need to determine which Q the FPFV date is in.
If Month(StartDate) <= Q1 Then
Output = "Q1 " + CStr(Year(StartDate))
ElseIf Month(StartDate) <= Q2 Then
Output = "Q2 " + CStr(Year(StartDate))
ElseIf Month(StartDate) <= Q3 Then
Output = "Q3 " + CStr(Year(StartDate))
Else
Output = "Q4 " + CStr(Year(StartDate))
End If
CurCol = ActiveSheet.Range("A1:Z1").Find(Output).Address(ReferenceStyle:=xlR1C1)
CurCol = Right(CurCol, Len(CurCol) - InStrRev(CurCol, "C"))
CurCol = CurCol - 2
Output = ""
'Which Q is the LPLV date in?
If Month(EndDate) <= Q1 Then
Output = "Q1 " + CStr(Year(EndDate))
ElseIf Month(EndDate) <= Q2 Then
Output = "Q2 " + CStr(Year(EndDate))
ElseIf Month(EndDate) <= Q3 Then
Output = "Q3 " + CStr(Year(EndDate))
Else
Output = "Q4 " + CStr(Year(EndDate))
End If
EndCol = ActiveSheet.Range("A1:Z1").Find(Output).Address(ReferenceStyle:=xlR1C1)
EndCol = Right(EndCol, Len(EndCol) - InStrRev(EndCol, "C"))
QStartCol = ActiveSheet.Range("A1:IV1").Find("Q1 2003").Address(ReferenceStyle:=xlR1C1)
QStartCol = Right(QStartCol, Len(QStartCol) - InStrRev(QStartCol, "C"))
'I need to clear the current patient numbers.
ActiveSheet.Range(Cells(CInt(Target.Row), CInt(QStartCol)), Cells(2, 24)) = ""
'And now add the new numbers.
For i = CurCol To CInt(EndCol)
Cells(2, i) = Patients
Next
Application.EnableEvents = True
Exit Sub
ws_exit:
Application.EnableEvents = True
MsgBox "Something Went Wrong"
End Sub

wnazzaro
06-01-2005, 09:16 AM
Let me try and make this easier. When I type "2/26/08" into a cell with this code...


Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Target.Value
End Sub

...I get a MsgBox with nothing, a MsgBox with my date, and a third MsgBox with my date. When I change the dates with the code above this post, the cell never changes.

Aaargh.

Killian
06-01-2005, 09:31 AM
With your simple example, do you have any other worksheet or workbook events that may be firing (and changing values) that are causing this to run again?
With your main code, you are changing cell values at the end, which will cause the event to fire again. You might want to insert a breakpoint or two so yo can follow whats going on (and use watches or the locals window to check the values).

Bob Phillips
06-01-2005, 10:12 AM
This also seems to run 2 to 3 times. And it never updates the cell.
I'm running Excel 2002.

I've run it a bit, without your data it is difficult, but it seems to go through as you would expect. Assuming your logic is correct, I can't see what is wrong. It only goes through once and updates data.

I did simplify the code a bit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim StartDate As Date, EndDate As Date
Dim Output As String, PatCol As Variant
Dim CurCol As Variant, EndCol As Variant
Dim FPFVCol As Variant, LPLVCol As Variant
Dim Patients As Integer, i As Integer
Dim QStartCol As Variant, QEndCol As Variant
Dim cell As Range
Application.EnableEvents = False
On Error GoTo ws_exit:
'No need to run this if the Header row is changed.
If Target.Row = 1 Then
Application.EnableEvents = True
Exit Sub
End If
'Which column is the FPFV date in?
FPFVCol = Application.Match("FPFV", Range("A1:IV1"), 0)
'Which column is the LPLV date in?
LPLVCol = Application.Match("LPLV", Range("A1:IV1"), 0)
If Target.Column <= LPLVCol Then
If Target.Column = FPFVCol Then
If Cells(CInt(Target.Row), CInt(LPLVCol)) = IsEmpty(Empty) Then
Application.EnableEvents = True
Exit Sub
Else
StartDate = Target.Value
EndDate = Cells(CInt(Target.Row), CInt(LPLVCol))
End If
ElseIf Target.Column = LPLVCol Then
If Cells(Target.Row, FPFVCol) = IsEmpty(Empty) Then
Application.EnableEvents = True
Exit Sub
Else
EndDate = Target.Value
StartDate = Cells(Target.Row, FPFVCol)
End If
Else
Application.EnableEvents = True
Exit Sub
End If
End If
PatCol = Application.Match("Patients", Range("A1:IV1"), 0)
Patients = Cells(CInt(Target.Row), CInt(PatCol))
If Patients = 0 Then
MsgBox "You need to add the number of patients.", vbInformation Or vbOKOnly, _
"Zero Patients"
Application.EnableEvents = True
Exit Sub
End If
'I need to determine which Q the FPFV date is in.
Output = "Q" & (Month(StartDate) - 1) \ 3 + 1 & " " & Year(StartDate)
CurCol = Application.Match(Output, Range("A1:Z1"), 0)
'Which Q is the LPLV date in?
Output = "Q" & (Month(EndDate) - 1) \ 3 + 1 & " " & Year(EndDate)
EndCol = Application.Match(Output, Range("A1:Z1"), 0)
QStartCol = Application.Match("Q1 2003", Range("A1:IV1"), 0)
'I need to clear the current patient numbers.
ActiveSheet.Range(Cells(CInt(Target.Row), CInt(QStartCol)), Cells(2, 24)) = ""
'And now add the new numbers.
For i = CurCol To CInt(EndCol)
Cells(2, i) = Patients
Next
Application.EnableEvents = True
Exit Sub
ws_exit:
Application.EnableEvents = True
MsgBox "Something Went Wrong"
End Sub

wnazzaro
06-01-2005, 10:32 AM
With your simple example, do you have any other worksheet or workbook events that may be firing (and changing values) that are causing this to run again?


There is something called tm1_old.xla(tm1.xla) in the Project window. I can't view it because it launches a MsgBox "Project is unviewable" with the title "Project Locked". I think this was set up by the company I work for. I'll ask the help desk if they can assist me from here.

I can get the Sub to run really well the first time something is set up, but I can't change any values. In the simple code, it does allow the values to change, but not the first time it runs, only the second (and sometimes third).

Thanks, I'll try to work at it from this end.

xld, the spreadsheet is simple. One column with patient numbers, one with a FPFV date, one with a LPLV date, and then columns with Q1 2003 through Q4 2008 (or whatever).

Thanks for updating the code. It was a bit of a mess when I posted it. For example: CInt(Target.Row) does nothing, it was the CInt(LPLVCol) that I needed to deal with the errors I was getting.

Code and learn, code and learn.

Bill

wnazzaro
06-01-2005, 11:05 AM
Killian found it. It was an Add-In in Excel. Once that was unticked, the code worked fine (after I fixed a few things).

xld: Application.Match is great. Now I don't have to do those flips to return the column number.

Again, thanks for all the help.

Bill