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.