简体   繁体   中英

Excel keeps crashing with Worksheet_selectionChange

I am running two VBA formulas.

The first hides all cells with empty information the first column.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     Dim c As Range
     On Error Resume Next

     Application.ScreenUpdating = False

     For Each c In Range("A3:A49")
        If c.Value = vbNullString Then
            c.EntireRow.Hidden = True
        End If
    Next c

    For Each c In Range("A3:A47")
        If c.Value <> vbNullString Then
            c.EntireRow.Hidden = False
        End If
    Next c

    Application.ScreenUpdating = True

End Sub

The second Formula strings data together and placeses this information in the next cell that is empty (aka the first hidden cell) when the button is clicked.

Option Explicit

    Dim iwsh As Worksheet
    Dim owsh As Worksheet
    Dim output As String
    Dim i As Integer

    Sub Copy()

    Set iwsh = Worksheets("Budget")
    Set owsh = Worksheets("Release Burnup")

    i = 3

    While owsh.Cells(i, 1) <> ""

    i = i + 1

    Wend

    output = "R" & iwsh.Cells(13, 2).Value & "-S" & iwsh.Cells(14, 2).Value

    owsh.Cells(i, 1) = output

    ActiveSheet.EnableCalculation = False
    ActiveSheet.EnableCalculation = True

End Sub

Previously, this has been causing no problem... Something has happened that is causing the workbook to crash anytime I try to delete information out of one of the cells with the new data.

PS: This is the list of my other formulas. maybe there is something in these that is interacting with the formentioned code?

Private Sub NewMemberBut_Click()

    'causes userform to appear
    NewMember.Show

    'reformats button because button kept changing size and font
    NewMemberBut.AutoSize = False
    NewMemberBut.AutoSize = True
    NewMemberBut.Height = 40.25
    NewMemberBut.Left = 303.75
    NewMemberBut.Width = 150

End Sub

'Similar code to the problematic code in question, but this one works fine
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim c As Range
    On Error Resume Next

    Application.ScreenUpdating = False

    For Each c In Range("A3:A35,A41:A80")
        If c.Value = vbNullString Then
            c.EntireRow.Hidden = True
        End If
    Next c

    For Each c In Range("A3:A35,A41:A80")
        If c.Value <> vbNullString Then
            c.EntireRow.Hidden = False
        End If
    Next c

    Application.ScreenUpdating = True

End Sub


'Code for UserForm

Option Explicit

    Dim mName As String
    Dim cName As String
    Dim mRole As String
    Dim cRole As String
    Dim i As Integer
    Dim x As Integer
    Dim Perc As Integer
    Dim Vac As Integer
    Dim Prj As Worksheet
    Dim Bud As Worksheet

Private Sub NewMember_Initialize()

    txtName.Value = ""

    cboRoleList.Clear

    Scrum.Value = False

    txtPercent.Value = ""

    txtVacation.Value = ""

    txtName.SetFocus

End Sub

Private Sub AddMember_Click()

    If Me.txtName.Value = "" Then
        MsgBox "Please enter a Member name.", vbExclamation, "New Member"
        Me.txtName.SetFocus
    Exit Sub
    End If

    If Me.cboRoleList = "Other" And Me.txtCustomRole = "" Then
        MsgBox "Please provide a role name.", vbExclamation, "Other Role"
    Exit Sub
    End If

    If Me.cboRoleList.Value = "" Then
        MsgBox "Please select a Role.", vbExclamation, "Member Role"
        Me.cboRoleList.SetFocus
    Exit Sub
    End If

    If Me.cboRoleList <> "Other" And Me.txtPercent = "" Then
        MsgBox "Please select a valid percentage to be applied to this sprint.", vbExclamation, "Sprint Percent"
        Me.txtPercent.SetFocus
    Exit Sub
    End If

    If Me.txtPercent.Value > 100 And Me.txtPercent <> "" Then
        MsgBox "Please select a valid percentage to be applied to this sprint.", vbExclamation, "Sprint Percent"
        Me.txtPercent.SetFocus
    Exit Sub
    End If

    If Me.txtVacation.Value = "" Then
        Me.txtVacation.Value = 0
    End If

    Dim i As Long

    Set Prj = Worksheets("Project Team")
    Set Bud = Worksheets("Budget")

    Prj.Activate

    i = 5
    x = 1
    If Me.cboRoleList.Value = "Other" Then
        i = 46
    End If


    While Prj.Cells(i, 1) <> ""
        i = i + 1
    Wend

    If cboRoleList = "Other" Then
        Cells(i, x).Value = txtCustomRole.Value
    End If

    If cboRoleList <> "Other" Then
        Cells(i, x).Value = cboRoleList.Value
    End If
    x = x + 1

    Cells(i, x).Value = txtName.Value
    x = x + 1

    If Me.cboRoleList.Value <> "Other" Then
        Cells(i, x).Value = txtPercent.Value
    End If

    Unload Me
End Sub


Private Sub CloseBut_Click()

    Unload Me

End Sub

Change the event driven Worksheet_SelectionChange to Worksheet_Change and isolate further by only processing when something changes in A3:A49.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A3:A49")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim c As Range
        For Each c In Intersect(Target, Range("A3:A49"))
            c.EntireRow.Hidden = CBool(c.Value = vbNullString)
        Next c
    End If

safe_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Caveat: A Worksheet_Change is not triggered on the change in a cell from the cell's formula. Only by typing, deleting or dragging a cell's contents. Adding or removing a formula will trigger it but not when a formula's result changes from another value somewhere in the workbook changing. This should not affect you as no formula can return vbNullString but it is worth mentioning for others.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM