none
EXCEL VBA (Worksheet_BeforeDoubleClick) event keeps crashing. RRS feed

  • Question

  • The folowing code makes my EXCEL crash, what am im doing wrong?

    The idea is that when i double click on a cell (in the range"I2:J31") it changes 2 values on the table (same ROW diferent COLUMN's) but before copy's the current values of the entire ROW that i double click on to a general table first empty ROW and also for a second table that depends on the value of the first COLUMN of the clicked ROW.

    Option Explicit

    'ON VM CHECK OR PT CHECK DOUBLE CLICK CHANGE LAST VISIT TO TODAYS DATE AND CHECKED BY VALUE ACORDINGLY

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

        On Error GoTo ws_exit
        Application.EnableEvents = False

    '    Const WS_RANGE As String = "I2:J31" 'RANGE WHERE THE DOUBLE CLICK WILL WORK

    '    If Target.Cells.Count = 1 Then
    '    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        If (Target.Column = 9 Or Target.Column = 10) And (Target.Row > 1 And Target.Row < 32) And Target.Cells.Count = 1 Then

            Dim answer As Integer

            answer = MsgBox("Are you sure you want to change last visit date for today?", vbYesNo + vbQuestion, "Update LAST VISIT and VISITED BY")

            If answer = vbYes Then

                Dim intLastRow As Long
                intLastRow = Sheet32.Cells(Sheet32.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                Sheet32.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value 'BACKUP TO CLIENT LOG

                Select Case ActiveSheet.Cells(Target.Row, 1) 'BACKUP OLD DATA ENTRY TO INDIVIDUAL CIENT LOG
                    Case "CLIENT1"
                        intLastRow = Sheet7.Cells(Sheet7.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet7.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT2"
                        intLastRow = Sheet9.Cells(Sheet9.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet9.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT3"
                        intLastRow = Sheet12.Cells(Sheet12.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet12.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT4"
                        intLastRow = Sheet13.Cells(Sheet13.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet13.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT5"
                        intLastRow = Sheet14.Cells(Sheet14.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet14.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT6"
                        intLastRow = Sheet16.Cells(Sheet16.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet16.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "MIX"
                        intLastRow = Sheet18.Cells(Sheet18.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet18.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENT7"
                        intLastRow = Sheet19.Cells(Sheet19.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet19.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    Case "CLIENTX"
                        intLastRow = Sheet20.Cells(Sheet20.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                        Sheet20.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                    
                End Select

                Cells(Target.Row, 3).Value = Date 'CHANGE LAST VISIT DATE FOR TODAY

                Select Case Target.Column 'CHANGE VISITED BY
                    Case 9
                        Cells(Target.Row, 4).Value = "PT" 
                    Case 10
                        Cells(Target.Row, 4).Value = "VM"
                End Select
            End If

        End If

    Cancel = True

    ws_exit:
        Application.EnableEvents = True

    End Sub

    Thank you in advance for your help.

    Wednesday, November 25, 2015 2:44 PM

All replies

  • Hi Pedro,
    >> The folowing code makes my EXCEL crash, what am im doing wrong?

    When did you get Excel crash? I made a simple test with modifying your code, but I failed to reproduce your issue.

    My simple code like below:

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     'On Error GoTo ws_exit
         Application.EnableEvents = False
         Dim Sheet32 As Worksheet
         Set Sheet32 = Worksheets("Sheet32")
              Dim Sheet7 As Worksheet
         Set Sheet7 = Worksheets("Sheet7")
    
     '    Const WS_RANGE As String = "I2:J31" 'RANGE WHERE THE DOUBLE CLICK WILL WORK
    
     '    If Target.Cells.Count = 1 Then
     '    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
         If (Target.Column = 9 Or Target.Column = 10) And (Target.Row > 1 And Target.Row < 32) And Target.Cells.Count = 1 Then
    
             Dim answer As Integer
    
             answer = MsgBox("Are you sure you want to change last visit date for today?", vbYesNo + vbQuestion, "Update LAST VISIT and VISITED BY")
    
             If answer = vbYes Then
    
                 Dim intLastRow As Long
                 intLastRow = Sheet32.Cells(Sheet32.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                 Sheet32.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value 'BACKUP TO CLIENT LOG
    
                 Select Case ActiveSheet.Cells(Target.Row, 1) 'BACKUP OLD DATA ENTRY TO INDIVIDUAL CIENT LOG
                     Case "CLIENT1"
                         intLastRow = Sheet7.Cells(Sheet7.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
                         Sheet7.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT2"
    '                     intLastRow = Sheet9.Cells(Sheet9.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet9.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT3"
    '                     intLastRow = Sheet12.Cells(Sheet12.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet12.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT4"
    '                     intLastRow = Sheet13.Cells(Sheet13.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet13.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT5"
    '                     intLastRow = Sheet14.Cells(Sheet14.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet14.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT6"
    '                     intLastRow = Sheet16.Cells(Sheet16.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet16.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "MIX"
    '                     intLastRow = Sheet18.Cells(Sheet18.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet18.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENT7"
    '                     intLastRow = Sheet19.Cells(Sheet19.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet19.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
    '                 Case "CLIENTX"
    '                     intLastRow = Sheet20.Cells(Sheet20.Rows.Count, "A").End(xlUp).Row 'FIND INDEX OF LAST ROW
    '                     Sheet20.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value
                     
                 End Select
    
                 Cells(Target.Row, 3).Value = Date 'CHANGE LAST VISIT DATE FOR TODAY
    
                 Select Case Target.Column 'CHANGE VISITED BY
                     Case 9
                         Cells(Target.Row, 4).Value = "PT"
                     Case 10
                         Cells(Target.Row, 4).Value = "VM"
                 End Select
             End If
    
         End If
    
     Cancel = True
    
    ws_exit:
         Application.EnableEvents = True
    
     End Sub
    

    Where did you set Sheet32 and Sheet7? I suggest you set them in the Worksheet_BeforeDoubleClick event. I suggest you put breakpoint and debug your code step by step to check which line cause your excel crash.

    It would be helpful if you could share us your simple excel file through OneDrive and steps to reproduce your issue.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Thursday, November 26, 2015 2:41 AM
  • Excel crashes when you double click on (I2:J31) on the PMC CHECKS spreadsheet.

    https://onedrive.live.com/redir?resid=1D8D57D2067D215A!2321&authkey=!AF_fl_1DqCP4sok&ithint=file%2cxlsm

    Best regards,

    Pedro

    Thursday, November 26, 2015 12:28 PM
  • Hi Pedro,

    Based on your document, I think this issue was caused by that you copy rows with “EntireRow.Value”. It would copy much large column which would make excel no response. Since most of the columns are not needed. I suggest you using Range.Copy to copy the rows instead of using setting entire row value.

    Here is a simple code, and you need to replace all of the EntireRow.Value place:

    Sub test()
    Worksheets("PMC CHECK's").Range("A5:J5").Copy _
        Destination:=Worksheets("CHECK LOG").Range("A62")
    End Sub

    For more information about Range.Copy, you could refer the link below:
    # Range.Copy Method (Excel)
    https://msdn.microsoft.com/en-us/library/office/ff837760.aspx?f=255&MSPPError=-2147217396

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Friday, November 27, 2015 5:59 AM
  • I think  EntireRow.Value works fine on a Worksheet_Change event i have with pretty much the same code, so i think thats not the problem.

    I manage to make it not crash and changes the value on the CLIENT_CHECK sheet but it still doesn't back up the values to the COLECTIVE_LOG sheet or the INDIVIDUAL_LOG sheet (That depends on the name of the Client).

    I need a way to use Range in a way that enables me to copy the (Target.row : 1) to (Target.row : 8) something more or less like this but that works :

    Sheet32.Range(Cells(intLastRow + 1, 1), Cells(intLastRow + 1, 8)) = Sheet1.Range(Cells(Target.Row, 1), Cells(Target.Row, 8))

    Insted of the EntireRow.value :

    Sheet32.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value

    I tryed with For to Next  but it still doesnt work, Also added a adicional Cell with a "Client INDEX" just in case the SELECT CASE doesn't work well with Strings.

    Here is the current version of the code :

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
        On Error GoTo ws_exit
        Application.EnableEvents = False
    
        If (Target.Column = 9 Or Target.Column = 10) And (Target.Row > 1 And Target.Row < 32) Then ' And Target.Cells.Count = 1
    
            Dim answer As Integer
            answer = MsgBox("Are you sure you want to change last visit date for today?", vbYesNo + vbQuestion, "Update LAST VISIT and VISITED BY")
    
            If answer = 6 Then '6= vbYes
    
                Sheet1.Cells(Target.Row, 3) = Date 'CHANGE LAST VISIT DATE FOR TODAY
    
                Select Case Target.Column 'CHANGE VISITED BY
                    Case 9
                        Sheet1.Cells(Target.Row, 4) = "PT"
                    Case 10
                        Sheet1.Cells(Target.Row, 4) = "VM"
                End Select
                
                Dim intLastRow As Long
    
                intLastRow = Sheet32.Cells(Sheet32.Rows.Count, "A").End(xlUp).Row
                Sheet32.Range(Cells(intLastRow + 1, 1), Cells(intLastRow + 1, 8)) = Sheet1.Range(Cells(Target.Row, 1), Cells(Target.Row, 8))
    '            Sheet32.Rows(intLastRow + 1).EntireRow.Value = Sheet1.Rows(Target.Row).EntireRow.Value '(OLD CODE - probably the source of the error)
                
                Dim forColumn As Integer
                MsgBox ("THE PROBLEM IS ON THE SELECT CASE")
                Select Case Sheet1.Cells(Target.Row, 11)
                    Case 7 'Client 1 INDEX
                        intLastRow = Sheet7.Cells(Sheet7.Rows.Count, "A").End(xlUp).Row
                        For forColumn = 1 To 8
                            Sheet7.Cells(intLastRow, forColumn) = Sheet1.Cells(Target.Row, forColumn)
                        Next forColumn
                    Case 9 'Client 2 INDEX  
                        intLastRow = Sheet9.Cells(Sheet9.Rows.Count, "A").End(xlUp).Row
                        For forColumn = 1 To 8
                            Sheet9.Cells(intLastRow, forColumn) = Sheet1.Cells(Target.Row, forColumn)
                        Next forColumn
                    Case 12 'Client 3 INDEX
                        intLastRow = Sheet12.Cells(Sheet12.Rows.Count, "A").End(xlUp).Row
                        For forColumn = 1 To 8
                            Sheet12.Cells(intLastRow, forColumn) = Sheet1.Cells(Target.Row, forColumn)
                        Next forColumn
                    Case 13 'Client X INDEX
                        intLastRow = Sheet13.Cells(Sheet13.Rows.Count, "A").End(xlUp).Row
                        For forColumn = 1 To 8
                            Sheet13.Cells(intLastRow, forColumn) = Sheet1.Cells(Target.Row, forColumn)
                        Next forColumn
    
                End Select
    
    
            End If
    
        End If
    
    'Cancel = True
    
    ws_exit:
        Application.EnableEvents = True
    
    End Sub
    



     

    Pedro PT

    Thursday, December 10, 2015 2:57 PM
  • Hi Pedro,

    >> I need a way to use Range in a way that enables me to copy the (Target.row : 1) to (Target.row : 8) something more or less like this but that works

    In my above code, I have shared the code to copy range from “PMC CHECK's” to "CHECK LOG".

    With further test, it seems your issue is related with the format of the rest empty rows in target sheet which you want to set the values. For another suggestion, I suggest you delete all the rest rows in the target sheet, and then test your code again.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.



    Monday, December 14, 2015 6:00 AM