Consulting

Results 1 to 2 of 2

Thread: VBA Macro Causing Excel to Freeze When 2nd Copy of Sheet Added to Workbook

  1. #1

    VBA Macro Causing Excel to Freeze When 2nd Copy of Sheet Added to Workbook

    Hello,

    I'm working with Office 365. I have 1 workbook called "Results" and another called "Templates", the sheet in question ("RMW") is copied via the "Move or Copy" method from book "Templates" to "Results".

    In the sheet, there are three fields (H4,H5,H6) that need to be filled with specific text, or a message pops up, and the user is encouraged to close the workbook until updates can be made. This is done by the code included below. If these three fields are correctly filled in, a second copy of sheet "RMW" can be added to book "Results" with no problems. The problem arises if the first copy of "RMW" has blanks in the three fields.

    If there are blanks and a second copy of the sheet is moved from "Templates" to "Results", the Excel interface becomes non-responsive. Excel doesn't crash, the workbooks can still be closed using the X in the corner, and that prompts the closing macro appropriately. The sheet also does copy over, if the workbook is saved and re-opened. However, the interface of both workbooks (and any other workbooks open) do not update or change at all. This problem does not occur if the sheet is duplicated within the "Results" workbook, only if moving one from "Templates" to "Results".

    I am hoping someone could look at my code and see if they can identify what is causing this issue. This code is located in the corresponding sheet module.

    Private Sub Worksheet_Change(ByVal Target As Range)
        
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    
    
        ''''''
        Dim OutApp As Object
        Dim OutMail As Object
        Dim mailText As String
        
        Dim cell As Range
        Dim acceptLots As Variant
        Dim newLot As VbMsgBoxResult
        
        acceptLots = Array("S210243043", "S190820029", "S161128029")
        
        If Not Intersect(Target, Me.Range("H4:H6")) Is Nothing Then
            Application.EnableEvents = False
        
            For Each cell In Target
                If cell.Value <> "" Then
        
                If Not IsNumeric(Application.Match(cell.Value, acceptLots, 0)) Then
                    newLot = MsgBox("New lot detected. Reference values need to be changed." + vbNewLine + "Confirm new lot?", _
                    vbOKCancel, "New Lot #?")
                    
                        If newLot = vbOK Then
                        
                            cell.Value = ""
                        
                            MsgBox ("Request sent for update." + vbNewLine + "Please email Name with the new lot number and CoA." _
                            + vbNewLine + vbNewLine + "Results cannot be reported until the values have been updated." + vbNewLine + _
                            "Workbook will now attempt to close.")
                            
                            Set OutApp = CreateObject("Outlook.Application")
                            Set OutMail = OutApp.CreateItem(0)
                            
                                mailText = "New " + Cells(cell.Row, "F") + " detected in " + ActiveSheet.Name + "." + vbNewLine + _
                                "Please update macros and expected values rows. Thank you!"
                            
                                On Error Resume Next
                                With OutMail
                                    .To = "email"
                                    .Subject = "QC Template Update Request"
                                    .Body = mailText
                                    .Send
                                End With
                                On Error GoTo 0
                                
                            Set OutMail = Nothing
                            Set OutApp = Nothing
                            
                            ActiveWorkbook.Close
                        End If
                        
                        If newLot = vbCancel Then
                            cell.Value = ""
                        End If
                        
                End If
                
                End If
            Next
        End If
        
        '''''
        
    errH:
        If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description
        Application.EnableEvents = True
        
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End Sub

    While I am aware that I could train users to avoid this problem by ensuring they fill in the three problem fields before adding a new sheet, I am both trying to understand what is causing this issue to avoid it in the future and to minimize the chances of users encountering frustrating errors.

    Thank you for your time. Please let me know if there is further information needed.
    Attached Files Attached Files

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    From reading the code, I have to say that Blanks are allowed, even required.

    The Event sub is ran whenever any one of the three cells is changed, and all three cells are checked each time it runs. Note that it will also run if more that one cell is changed at a time (For example: by another sub pasting in an array.) If user ignores those three cells, the Change Event won't run

    The workbook is closed when 1)A cell has the wrong Lot #, and 2) A message requesting a new lot # is sent.

    I suggest moving that entire section of code to it's own Procedure(s).

    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        'Simple test
        If Target.Count > 1 Then Exit Sub
    
        If Not Intersect(Target, Me.Range("H4:H6")) Is Nothing Then ChecklLotNumber Target 'Target will be one cell
    End Sub
    
    Sub ChecklLotNumber(ByVal Target As Range)
    'Incomplete Procedure. Example only
    If Not IsNumeric(Application.Match(Target, acceptLots, 0)) Then
         newLot = MsgBox("New lot detected. Reference values need to be changed." + vbNewLine + "Confirm new lot?", _
         vbOKCancel, "New Lot #?")
                    
         If newLot = vbOK Then
             cell.Value = ""
    
      'Call Message sender    
     End Sub
    
    Sub MessageSender()
    'Incomplete Procedure. Example only
    mailText = "New " + Cells(cell.Row, "F") + " detected in " + ActiveSheet.Name + "." + vbNewLine + _
    Please update macros and expected values rows. Thank you!"
    End sub
    Having several small Procedures that only do one thing makes troubleshooting easier

    I don't know enough to suggest when to check for blank cells, but your code doesn't. The Deactivate Event is a possibility
    Last edited by SamT; 06-09-2021 at 01:03 AM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •