Hello OssieMac,
Thanks for the info and insights. My replies are in line below. I have also
included the two main routines involved in the error. And I'm using your
MYFilters function in a worksheet formula. In the code below, the error
occurs on the lines in the FillAcctCode routine in lines that have the
following kind of assigments:
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value = ""
The error is displayed by the MsgBox call at the bottom of the FillAcctCode
routine. It doesn't matter if the assignement is "" or another value.
John S.
OssieMac said:
Hi again John,
I still believe that somewhere Excel is confused with what worksheet is
being referenced. Code in the worksheet change event defaults to the
worksheet to which it is attached. If the event is triggered by something
that occurs in another worksheet that is actually the ActiveSheet then
problems occur if you refer to the ActiveSheet. A workaround is to place the
code in a standard module and call the sub from the worksheet change event.
However, a couple of questions.
Are you only working on one worksheet or on multiple worksheets?
Could you explain why that might be the case that Excel is confused? Do you
know how I could test that hypothosis? I wasn't convinced of this because all
I need to do to stop the error is comment out the Application.Volatile line
or remove the call to MyFilters() from the worksheet forumula.
The project is based on a Template WB. When the template is first opened,
there are two sheets. One sheet contains many lists used to populate
validation dropdown lists. These dropdown lists are referenced in cell
validation on the second master worksheet's that is used by the user to enter
data. I have a procedure that copies the master sheet so the user can create
multiple working sheets.
When the worksheet change event is triggered, is the ActiveSheet the same
worksheet to which the code belongs?
The Worksheet_change function resides in the master sheet described above.
So when the user creates a new workshee, the routing is copied as well. So
the Worksheet_change event is handled by the currently active sheet.
This Worksheet_Change function calls another macro in the Module1 code that
evenutally tries to update the cells in question. The RunTime error will
occur when I open the file as a template so there is only one copy of the
Worksheet_Change Event at that time.
Actually, you just gave me an idea to try. I think I'll move the problem
routine to the Sheet module and see if the error still occurs. I think I
tried that already, but I'll give it another go.
Can you post all of the worksheet change code that is causing the problem
and mark the line on which the problem occurs?
I'll try, but the code is pretty long, and contains references to Named
Ranges and a number of other support subroutines that may not make sense
outside of the whole project. See the code below.
You could also try Application.EnableEvents = False at the start of the code
causing the event to trigger and then turn it on again with
Application.EnableEvents = True at the end of the code. However, if you do
this then if you have a code failure before it is turned back on the events
are off untill turned on by code again. Therefore keep the following sub in
your project and run it if the above occurs.
Yes, I do that in the Worksheet_Change function. The design will not work
without that. And, yes, I have error handling in almost all the routines in
my project to handle just that case. In fact, the error is presented to the
user because of my error handling and the user is able to continue using the
workbook.
Sub Re_EnableEvents()
Application.EnableEvents = True
End Sub
Just place your cursor anywhere in the sub and press F5 to run it from the
VBA editor.
It will be quite a few hours before I get to answer this post again as I
have other thing on.
Here's the code:
Sheet2 code:
Private Sub Worksheet_Change(ByVal Target As Range)
' Macro created 5/15/2009 by John E. Spitzer
' Launch the macros that automatically fills in the account
' Code and Override columns and Account Code Expenses Table.
'
' If the user has selected cells in the Category or Subcategory columns
' then fill in Account Code and Expenses by Acct Code table
' Else if the user has selected cells in the Account Code column,
' fill in the Expenses by Acct Code table.
' We check for the desired selected columns explicitly instead of using
intersection
' because this seems to avoid flushing the undo stack for selections where
we aren't
' going to change the worksheet with the macros.
Dim colCategory As Long
Dim colAccount As Long
Dim colAllocTable As Long
Dim rtnVal As Boolean
On Error GoTo ErrThisSub
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Debug.Print "-> Worksheet_Change: Name: '" & Me.Name & "' " & Target.Address
' Don't invoke the Account code functions if the entire row is selected.
If Target.Address <> Target.EntireRow.Address Then
' if the selection includes cells from the category or subcategory columns
' in the Expenditure table OR cells from the Budget allowcation table
' then fill in the account code and update the Account Code table.
colCategory = Me.Range("Bud_CatSubCatCols").Column
If (Target.Column + Target.Columns.Count - colCategory > 0 And _
colCategory + 1 - Target.Column >= 0 And _
Target.Row >= Me.Range("Bud_ExpenditureTable").Row) Then
' ActiveSheet.Range("Bud_AcctRef").ClearContents
FillAcctCode Target
GetUniqueAccts
ElseIf (Target.Column + Target.Columns.Count - colCategory + 1 > 0 And _
colCategory + 2 - Target.Column >= 0) And _
(Target.Row >= Me.Range("Bud_AllocationTable").Cells.Row And _
Target.Row < Me.Range("Bud_AllocationTable").Cells.Row + _
Range("Bud_AllocationTable").Rows.Count) Then
' if selection includes cells from the Allocation table then.
' ActiveSheet.Range("Bud_AcctRef").ClearContents
If Target.Column - colCategory + 1 <> 0 Then
FillAcctCode Target
End If
GetUniqueAccts
' Cells("K12").Value = MyFilters(Range("C30"))
Else
' if the selection includes cells from the Account code column
' then update the Account Code table.
colAccount = Me.Range("Bud_AcctCodeCol").Column
If Target.Column + Target.Columns.Count - colAccount > 0 And _
colAccount - Target.Column >= 0 And _
Target.Row >= Me.Range("Bud_ExpenditureTable").Row Then
SetOverRide Target
GetUniqueAccts
End If
End If
End If
GoTo ExitThisSub
ErrThisSub:
' place holder for error handling when it becomes needed.
'Debug.Print "<- Worksheet_Change: ERR: " & Err.Number
Resume ExitThisSub
ExitThisSub:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
'Debug.Print "<- Worksheet_Change: "
End Sub
====================================
Module1 code:
Sub FillAcctCode(ByVal Target As Range)
'======================================================================
' Purpose - For each row that has selected cells,
' If we are in the main Expenditure table then
' If the override field is not set, then
' if there is a value for the category and subcategory columns
' fill in the account code column
' call function to fill in the override column.
' Else we are in the Budget Category table.
' fill in the account code column
'
' By: John Spitzer
' Date: 05/15/2009
Dim rngCatSubcat As Range
Dim rngCurrRow As Range
Dim rngCurrAcct As Range
Dim colCategory As Long
Dim colAccount As Long
Dim strAcctCode As String
'Debug.Print "-> FillAcctCode: " & Err.Number
On Error GoTo ErrThisSub
If Target.Row >= Range("Bud_ExpenditureTable").Row Then
Set rngCatSubcat = Application.Intersect(Target,
Range("Bud_CatSubCatCols"))
Else
Set rngCatSubcat = Application.Intersect(Target,
Range("Bud_AllocationTable"))
' GoTo ExitThisSub
End If
' Loop through all the selected rows and
' if the category or subcategory columns are empty clear the account code
' else fill in the account code.
For Each rngCurrRow In rngCatSubcat
If Target.Row >= Range("Bud_ExpenditureTable").Row Then
colCategory = Range("Bud_CatSubCatCols").Column
colAccount = Range("Bud_AcctCodeCol").Column
' If the character in the override column isn't #, then fill in the
account code.
If ActiveSheet.Cells(rngCurrRow.Row, colAccount - 1).Value <> _
ActiveSheet.Cells(Range("Bud_AcctCodeCol").Row - 1, colAccount -
1).Value Then
' If the Category or Subcategory is empty then don't fill in account
code,
' else fill in account code and put space in override column.
If Cells(rngCurrRow.Row, colCategory) = "" Or Cells(rngCurrRow.Row,
colCategory + 1) = "" Then
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value = ""
Else
' Put a char in override colum so Item Description doesn't bleed
into column.
ActiveSheet.Cells(rngCurrRow.Row, colAccount - 1).Value = " "
strAcctCode = BuildAccountCode(rngCurrRow)
If Len(Trim(strAcctCode)) > 0 Then
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value =
strAcctCode
Else
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value = ""
End If
End If
Else
' The Override is set, but check if the user has set category and
subcategory
' that matches the account code.
Set rngCurrAcct = Range(Cells(rngCurrRow.Row, colAccount),
Cells(rngCurrRow.Row, colAccount))
SetOverRide rngCurrAcct
End If
Else
colCategory = Range("Bud_AllocationTable").Column + 1
colAccount = Range("Bud_AllocationTable").Column
strAcctCode = BuildAccountCode(rngCurrRow)
If Len(Trim(strAcctCode)) > 0 Then
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value = strAcctCode
Else
ActiveSheet.Cells(rngCurrRow.Row, colAccount).Value = ""
End If
End If
Next rngCurrRow
GoTo ExitThisSub
ErrThisSub:
' place holder for error handling when it becomes needed.
'Debug.Print "-- FillAcctCode: " & Err.Number
MsgBox "Unexpected error:" & vbCrLf & _
"FillAccountCode: Error: " & Err.Number & " - " & Err.Description
Resume ExitThisSub
ExitThisSub:
'Debug.Print "<- FillAcctCode: " & Err.Number
End Sub
