Workbook_Change stopped working !

krissz · Nov 10, 2019

I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the user. The user is allowed access to 2 columns, 'Account Code' & 'VAT Rate'. Entry is restricted by Data Validation, the user selecting from lists.
Workbook_Change is used to amend data in other columns depending on the selection.
I did work very well, but having corrected other problems & my errors, Workbook_Change no longer works.
Application.EnableEvents is set true.
Help.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'   Checks whether Account is changed or VAT is set

    Dim Msg_Ans As Integer
    Dim Msg_Txt As String
    Dim VAT1 As Integer
    Dim VAT2 As Integer
    
    On Error Resume Next
    Target.Range = Range("H:I")
    

    VAT1 = Worksheets("Master").Range("VAT_R1").Value
    VAT2 = Worksheets("Master").Range("VAT_R2").Value
    
    If Target.Column = 8 Then
    ...
    ...

    Range("Q" & ActiveCell.Row).Value = Left(Range("H" & ActiveCell.Row).Value, 3)
    End If

    If Target.Column = 9 Then
        Application.EnableEvents = False
        ....
        ....
            
    End If
    Application.EnableEvents = True

End Sub

krissz · Nov 12, 2019

I spoke too soon. I processed one set of data OK and Excel closed - as is intended.
Loaded a second set of data & found that Application.EnableEvents was not working.
Re-booted, as that seems to have helped before.
Excel seems to have become corrupted (a problem that I have noticed before with this code.
In particular, cells with an equation involving text evaluate to 0 rather than to the expected text string.
data in these cells include file names, file locations, etc which are computed automatically.
Currently running a full repair on Excel. Thanks in advance

shg · Nov 12, 2019

I think repairing Excel is a waste of time, and your problem would go away if you put in some error handling and figured out what's causing the problem.

krissz · Nov 12, 2019

If I do not repair excel, Nothing works. Repairing / Reboot gets it working. Need to check which is important, or do I need both.
In the Worksheet_Change routine, I have an error routing with a message box. In the rest of the programme, I use Error Goto 0. At no time have any of of these traps been triggered. Because of deadlines, I am now having to process much of this work by hand, which does not help.
I previously had this routine working under win 7 & Excel 2010. Part of that code was corrupted but the Worksheet_Change routine survived. I can think of several ways to modify the code, but all will require to be triggerd by Worksheet_Change.
Thanks for the suggestions; any further help would be appreciated
.
PS I am not a total novice. I have been involved with code since the very early 1960s & mainframes.

shg · Nov 12, 2019

The code in post 1 contains no error handling.

krissz · Nov 13, 2019

I followed your advice & added error handling

shg · Nov 13, 2019

And ...?

krissz · Nov 13, 2019

No errors detected.

shg · Nov 13, 2019

Can you post your code?

krissz · Nov 14, 2019

This application runs in 4 worksheets, plus an extra one which I have used to store some data like the CoA.
It opens on the 'Master' worksheet. The user selects the applicable month & year & clicks on the 'Load File' button which calls the 'Load_CSV' sub.
This data (a CSV file) loads into worksheet 'statement_yyyy-mm'
Once the data has been loaded, the user is presented with the 'Entry' tab. He has the oportunity to change the Account Code & Tax Rate. Data validation is used to ensure that only suitable values are used. WorksheetChange detects any changes & updates the screen data.
Once entry is completed, clicking on the 'Save' button copies & reformats the data in the 'Output' tab, saves the workbook & then the CSV file (from Output). A message advises he user that the operation has completed. clicking YES exits the workbook.

Module 1 Code:

Code:

Option Explicit

    Public F_Nam As String

    Private Sub Workbook_Open()
        Application.WindowState = xlMaximized
        Application.EnableEvents = True
    End Sub


Sub Load_CSV()
'   Called by the "Load File" button in the Master Tab

    Dim WS_Sht As Worksheet
    Dim WS_Name As String
    Dim CSV_Name As String
    Dim NT_Nam As String        'New Tab Name
    Dim L_Row As Long
    Dim rng As Range
    
    On Error GoTo 0
    
' Find the data input sheet, named statement_yyyy-mm
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("Master").Activate
    Call WorksheetLoop
    ActiveWorkbook.Sheets("Master").Activate
    NT_Nam = Range("Input_tab").Value
    ActiveWorkbook.Sheets("Master").Activate
    
'   Puts the Tab name into Master!B2
'    Range("Master!B2").Select
'    Selection.Value = "statement_" + F_Nam
    
'    Selection.Copy
'    Selection.PasteSpecial Paste:=xlValues
'    Application.CutCopyMode = False
    WS_Name = Range("B17").Value
    Set WS_Sht = ActiveWorkbook.Worksheets(NT_Nam)
    WS_Sht.Activate

' Delete any existing data
    Range("A1").Value = Range("Master!B19").Value
    ActiveSheet.Name = NT_Nam
    L_Row = WS_Sht.Cells(WS_Sht.Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A2:A" & L_Row)
    If Not rng Is Nothing Then rng.EntireRow.Delete

    'Import CSV file
    CSV_Name = Range("Master!B3").Value & Range("Master!B17").Value
    Call ImportFile("A2", CSV_Name)
    Application.EnableEvents = True
    
    Call Entry_Sht

End Sub
   

Sub WorksheetLoop()
    ' Finds the Tab with the downloaded data
    
    Dim WS_Count As Integer
    Dim WS_Name As String
    Dim WS_Sht As Worksheet
    Dim I As Integer

    WS_Count = ActiveWorkbook.Worksheets.Count

    For I = 1 To WS_Count
        Set WS_Sht = ActiveWorkbook.Worksheets(I)
        ActiveWorkbook.Worksheets(I).Activate
        If Mid(WS_Sht.Name, 1, 9) = "statement" Then
            ActiveSheet.Name = Sheets("Master").Range("$B$14").Value
            Exit Sub
        End If
    Next I
End Sub

Sub Entry_Sht()
    'Setup Entry sheet

    Dim Col_Range As Range
    Dim Paste_Range As Range
    Dim rng As Range
    Dim E_Msg As String
    Dim M_Title As String
    Dim M_Ans As Integer
    Dim Last_Row As Integer
    Dim C_Row As Integer
    Dim S_Sheet As String
    Dim S_Rng1 As String
    Dim S_Rng2 As String
    Dim S_Val As Variant
    Dim Test_Val As String
    
    Application.EnableEvents = True

' Delete existing data
    ActiveWorkbook.Sheets("Entry").Activate
    Last_Row = Worksheets("Entry").Cells(Worksheets("Entry").Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A12:A" & Last_Row)
    On Error GoTo 0
    If Not rng Is Nothing Then rng.EntireRow.Delete
    
'   Copy values across from Statement_xxxxx to Entry Tabs
    ActiveWorkbook.Sheets("Entry").Activate
    Range("Q:Q").NumberFormat = "@"
    Range("G12").Select
    C_Row = 12
    S_Sheet = ThisWorkbook.Worksheets("Master").Range("Input_tab").Value

    Do While Worksheets(S_Sheet).Range("C" & C_Row - 10).Value > 0
        Sheets("Entry").Activate
        Range("A" & C_Row).Value = "Barclaycard Business"
        Range("B" & C_Row).Value = [File_Nam] & "-" & C_Row - 11
        Range("C" & C_Row).Value = Sheets(S_Sheet).Range("A" & C_Row - 10).Value
        Range("D" & C_Row).Value = Range("C" & C_Row).Value + 31
        Range("E" & C_Row).Value = Sheets(S_Sheet).Range("B" & C_Row - 10).Value
        Range("F" & C_Row).Value = 1

        Sheets(S_Sheet).Activate
        S_Val = Range("G" & C_Row - 10).Value + Range("F" & C_Row - 10).Value
        
        Sheets("Entry").Activate
        With Range("G" & C_Row)
          .Value = S_Val
          .NumberFormat = "#,##0.00;[Red]#,##0.00"
        End With
        
        Range("P" & C_Row).Value = Range("G" & C_Row).Value
'        Range("Q" & C_Row).Value = Left(Range("H" & C_Row).Value, 3)
        
        C_Row = C_Row + 1
    Loop
   
    ActiveWorkbook.Sheets("Entry").Activate
    ActiveWindow.DisplayZeros = False
    Rows("2:999").EntireRow.Hidden = False
    Set Col_Range = Range("C12:C500")
    Last_Row = Application.WorksheetFunction.CountIf(Col_Range, ">0")
    
    Range("Entry!A1").Select
    Range("Entry!h12").Value = Range("Master!B152").Value
    Range("Entry!i12").Value = Range("Master!B94").Value
    Range("h12:i12").Select
    Selection.Copy
    Range("h13:i" & Last_Row + 11).Select
    ActiveSheet.Paste
    
    Range("Q12").Value = Left(Range("H12").Value, 3)
    Range("Q12").Select
    Selection.Copy
    Range("Q13:Q" & Last_Row + 11).Select
    ActiveSheet.Paste

    With Range("J:J")
        .NumberFormat = "#,##0.00;[Red]#,##0.00"
    End With
    Application.CutCopyMode = False

'   Blank rows which say Payment
    Range("E12").Select
    C_Row = 12
    Do While Range("C" & C_Row).Value > 0
        Range("E" & C_Row).Select
        If StrComp("Payment", Left(Trim(ActiveCell.Value), 7), vbTextCompare) = 0 Then
            Range("G" & C_Row).Value = 0
            Rows(ActiveCell.Row).EntireRow.Hidden = True
        End If
        C_Row = C_Row + 1
     Loop
    
    Rows(Last_Row + 12 & ":999").EntireRow.Hidden = True
    Range("A12").Select
    ActiveWindow.FreezePanes = True
    Application.EnableEvents = True
    
    'User Message & instructions
    E_Msg = "Please set the appropriate Cost Code & VAT for each line"
    E_Msg = E_Msg & vbCr & "Values are selected from a table"
    M_Title = "Next"
    
    M_Ans = MsgBox(E_Msg, vbYesNo, M_Title)
    
    If M_Ans = vbYes Then
'        Call Check_10
    
    ElseIf M_Ans = vbNo Then
    
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
' End of the data entry sequence.   User selects cells in Col H or I which need altering

End Sub



Sub Export_Sheet()
' Export data.   Called by the "Save" button on the Entry Tab

    Dim Col_Range As Range
    Dim Last_Row As Integer
    Dim Local_Dir As String
    Dim C_Row As Integer
    
    Application.ScreenUpdating = False
    On Error GoTo 0
        
' Get the Save Directory Name
    Local_Dir = Sheets("Master").Range("Save_Dir").Value
    
'Clear previous entry
    Sheets("Output").Select
    Range("A1:M999").Clear
    
' Copy entered data & paste as values in the Output Tab
    ActiveWorkbook.Sheets("Entry").Activate
    Set Col_Range = Range("C12:C500")
    Last_Row = Application.WorksheetFunction.CountIf(Col_Range, ">0")
    Range("A11:J" & Last_Row + 11).Select
    Selection.Copy
    Sheets("Output").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C:D").NumberFormat = "dd/mm/yyyy"
    
    Range("A1").Select
    
    ' Copy Net values across
    ActiveWorkbook.Sheets("Entry").Activate
    Range("P12:P" & Last_Row + 11).Select
    Selection.Copy
    Sheets("Output").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

'   Copy Account codes across
    ActiveWorkbook.Sheets("Entry").Activate
    Range("Q12:Q" & Last_Row + 11).Select
    Selection.Copy
    Sheets("Output").Select
    Range("h2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

'   Delete rows which say Payment or with cost code = 0
    ActiveWorkbook.Sheets("Output").Activate
    Range("E2").Select
    C_Row = 2
    Do While Range("C" & C_Row).Value > 0
        
        Range("E" & C_Row).Select
        If StrComp("Payment", Left(Trim(ActiveCell.Value), 7), vbTextCompare) = 0 Then
            Rows(ActiveCell.Row).EntireRow.Delete
        
        ElseIf Range("H" & C_Row).Value = 0 Then
            Rows(ActiveCell.Row).EntireRow.Delete
        
        Else
            C_Row = C_Row + 1
        End If
     Loop

' Delete blank cells
     Call Del_Blank

'  Save worksheet
    Application.DisplayAlerts = False
    Worksheets("master").Select
    ThisWorkbook.Save
    Application.ScreenUpdating = True
    
 ' Save CSV Output File
    ThisWorkbook.Sheets("Output").Select
    Range("A1").Select
    Set Col_Range = Range("C2:C500")
    Last_Row = Application.WorksheetFunction.CountIf(Col_Range, ">0")
    Range("A1:J" & Last_Row + 1).Select
    ThisWorkbook.Sheets("Output").SaveAs Filename:=Local_Dir & Range("File_Nam").Value, FileFormat:=xlCSV
    
    Worksheets("master").Activate
    Range("A1").Select

'   Close This Workbook
    Application.DisplayAlerts = True
    MsgBox "All Complete" & vbNewLine & "Exit workbook"
    ActiveWindow.Close savechanges:=False

' The End
End Sub

Sub Del_Blank()
'Deletes single cells that are blank located inside a designated range

    Dim B_Rng As Range
    Dim C_Range As Range
    Dim Lst_Row As Integer

    Worksheets("Output").Select

    'Delete blank cells and shift upward
    Set C_Range = Range("C2:C500")
    Lst_Row = Application.WorksheetFunction.CountIf(C_Range, ">0")
    Range("A" & Lst_Row + 2 & ":J500").EntireRow.Delete
    
    On Error Resume Next
    Set B_Rng = Range("K1:Z100").SpecialCells(xlCellTypeBlanks)
    B_Rng.Columns.Delete Shift:=xlToLeft

    On Error GoTo 0

End Sub

Function ImportFile(myRange As String, myFilePath As String) As Long
' Import CSV file without generating a Query Table

    Dim myValue1 As String, myValue2 As String, myValue3 As String
    Dim myValue4 As String, myValue5 As String, myValue6 As String
    Dim myValue7 As String

    Dim myRecordCount As Long: myRecordCount = 0

    Open myFilePath For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]  ' Open file for input.

    Range(myRange).Select

    Do While Not EOF(1) ' Loop until end of file.
        Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , myValue1, myValue2, myValue3, myValue4, myValue5, myValue6, myValue7
    
    'Variable for each data field.
        Selection.Offset(myRecordCount, 0).Value = myValue1
        Selection.Offset(myRecordCount, 1).Value = myValue2
        Selection.Offset(myRecordCount, 2).Value = myValue3
        Selection.Offset(myRecordCount, 3).Value = myValue4
        Selection.Offset(myRecordCount, 4).Value = myValue5
        Selection.Offset(myRecordCount, 5).Value = myValue6
        Selection.Offset(myRecordCount, 6).Value = myValue7
    
        myRecordCount = myRecordCount + 1
    Loop

    ImportFile = myRecordCount
' Close file
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 

    End Function

Code:

Sheet 2 (Entry) code:

    Option Explicit
    Public Payee As String
    Public Add_Cnt As Integer
    Public Pay_Row As Integer
    
    

Private Sub Worksheet_Change(ByVal Target As Range)
'   Checks whether Account is changed or VAT is set

    Dim Msg_Ans As Integer
    Dim Msg_Txt As String
    Dim Msg_Ttl As String
    Dim VAT1 As Integer
    Dim VAT2 As Integer

    On Error GoTo ChangeError
    
    VAT1 = Worksheets("Master").Range("VAT_R1").Value
    VAT2 = Worksheets("Master").Range("VAT_R2").Value
    
    If Target.Column = 8 Then
        If Left(ActiveCell, 3) = "10 " Then
        ' Account Code has changed to 10
        
           Application.EnableEvents = False
           Msg_Txt = "You seeem to want to pay " & vbCrLf & _
               Sheets("Entry").Range("E" & ActiveCell.Row).Value & _
               vbCrLf & _
               vbCrLf & _
               "If this is not the exact hame of the Xero account, press NO & enter it"
           Msg_Ttl = "Paying Who ?"
               
           Msg_Ans = MsgBox(Msg_Txt, VbMsgBoxStyle.vbYesNo + vbExclamation, Msg_Ttl)

           If Msg_Ans = vbYes Then
                Payee = Range("E" & ActiveCell.Row).Value
                Pay_Row = ActiveCell.Row
                Add_Cnt = Add_Cnt + 1
            Else
                MsgBox ("Copy Data")
            End If
                
        End If
    
    Range("Q" & ActiveCell.Row).Value = Left(Range("H" & ActiveCell.Row).Value, 3)
    End If

    If Target.Column = 9 Then
        Application.EnableEvents = False
        
        If Left(ActiveCell, 2) = VAT1 Then
        ' 20% VAT
            Range("P" & ActiveCell.Row).Value = _
              Range("G" & ActiveCell.Row).Value / (1 + VAT1 / 100)
            Range("J" & ActiveCell.Row).Value = _
              Range("G" & ActiveCell.Row).Value - _
              Range("P" & ActiveCell.Row).Value

        ElseIf Left(ActiveCell, 2) = VAT2 Then
        ' 5% VAT
            Range("P" & ActiveCell.Row).Value = Range("G" & ActiveCell.Row).Value
            Range("P" & ActiveCell.Row).Value = _
              Range("G" & ActiveCell.Row).Value / (1 + VAT2 / 100)
            Range("J" & ActiveCell.Row).Value = _
              Range("G" & ActiveCell.Row).Value - _
              Range("P" & ActiveCell.Row).Value
        
        Else
        ' No VAT
            Range("P" & ActiveCell.Row).Value = Range("G" & ActiveCell.Row).Value
            Range("j" & ActiveCell.Row).Value = ""
        
        End If
            
    End If
    
    Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub

ChangeError:
    
    Msg_Ans = MsgBox("Error", vbYesNo)
    On Error GoTo 0
   
End Sub

Sheet 3 (Master code) :

Code:

Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
' Set format for Month Cell to Proper

      If Target.Column = 2 And Target.Row = 16 Then
        Range("B16").Value = WorksheetFunction.Proper(Range("B16").Value)
      End If
    End Sub

There is also some old code in Module 2 but this is never run.
At the moment, it all seems to be working, but it often has done so in the past.
I hope that you can find my mistake(s) & many thanks for your help.

ZVI · Nov 14, 2019

Hi,
Try these corrections (see code lines in Red):

Rich (BB code):

' Sheet 2
Private Sub Worksheet_Change(ByVal Target As Range)
'   Checks whether Account is changed or VAT is set

    Dim Msg_Ans As Integer
    Dim Msg_Txt As String
    Dim Msg_Ttl As String
    Dim VAT1 As Integer
    Dim VAT2 As Integer

    On Error GoTo ChangeError
    
    Application.EnableEvents = False  '<-- This should be here
    
    '... Your code
    
ChangeError:
    
    Msg_Ans = MsgBox("Error", vbYesNo)
    On Error GoTo 0
       
    Application.EnableEvents = True  '<-- This should be here

End Sub

Rich (BB code):

' Sheet 3
Private Sub Worksheet_Change(ByVal Target As Range)
  ' Set format for Month Cell to Proper
  
  Application.EnableEvents = False  '<-- This should be here
  
  If Target.Column = 2 And Target.Row = 16 Then
    Range("B16").Value = WorksheetFunction.Proper(Range("B16").Value)
  End If
  
  Application.EnableEvents = True  '<-- This should be here

End Sub

This excludes recursive call (with breaking after some iterations) of the Change code

Workbook_Change stopped working !

krissz

Board Regular

krissz

Board Regular

Excel Facts

shg

MrExcel MVP

krissz

Board Regular

shg

MrExcel MVP

krissz

Board Regular

shg

MrExcel MVP

krissz

Board Regular

shg

MrExcel MVP

krissz

Board Regular

ZVI

MrExcel MVP

Similar threads

Forum statistics

Share this page

Workbook_Change stopped working !

Board Regular

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock