QMHsowden
06-08-2021, 03:14 PM
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.
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.