Bug in VBA Code

[DataMngr]

Hi there!

I have a waiting list for group home admissions and code in VBA to send an entire row from one tab to another that has certain words such as "Admit" and "Cancel". When I use the drop down menu to select Admit, the screen freezes then pastes "Return" in the remaining status columns then the program crashes. What is causing this?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Integer
Dim b As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowb = Sheets("Admitted").Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowc = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Active").Activate
    For i = 1 To Lastrow
        If Cells(i, 11).Value = "Admit" Then
        Rows(i).Copy Destination:=Sheets("Admitted").Rows(Lastrowb)
        Lastrowb = Lastrowb + 1
        End If
    Next
    For b = Lastrowc To 1 Step -1
            If Cells(b, 11).Value = "Admit" Then
                Rows(b).EntireRow.Delete
            End If
    Next
Application.ScreenUpdating = True
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowb = Sheets("Canceled").Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowc = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Active").Activate
    For i = 1 To Lastrow
        If Cells(i, 11).Value = "Cancel" Then
        Rows(i).Copy Destination:=Sheets("Canceled").Rows(Lastrowb)
        Lastrowb = Lastrowb + 1
        End If
    Next
    For b = Lastrowc To 1 Step -1
            If Cells(b, 11).Value = "Cancel" Then
                Rows(b).EntireRow.Delete
            End If
    Next
Application.ScreenUpdating = True
End
End Sub

 

[JLGWhiz]

Since there is nothing in the posted macro to initiate the posting of "Return" anywhere, you obviously have another macro being triggered by the change which is doing the posting. If there is no other macro in your worksheet code module, check your ThisWorkbook code module to see if there is a Workbook_SheetChange macro that refers to the "Return" text.

 

[DataMngr]

Hi JLGWhiz,

I do have the Return triggered on Sheets 3 and 4. Here is the code:

sheet 3

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Integer
Dim b As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowb = Sheets("Active").Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowc = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Admitted").Activate
    For i = 1 To Lastrow
        If Cells(i, 11).Value = "Return" Then
        Rows(i).Copy Destination:=Sheets("Active").Rows(Lastrowb)
        Lastrowb = Lastrowb + 1
        End If
    Next
    For b = Lastrowc To 1 Step -1
            If Cells(b, 11).Value = "Return" Then
                Rows(b).EntireRow.Delete
            End If
    Next
Application.ScreenUpdating = True
End Sub

Sheet 4

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Integer
Dim b As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowb = Sheets("Active").Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowc = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Canceled").Activate
    For i = 1 To Lastrow
        If Cells(i, 11).Value = "Return" Then
        Rows(i).Copy Destination:=Sheets("Active").Rows(Lastrowb)
        Lastrowb = Lastrowb + 1
        End If
    Next
    For b = Lastrowc To 1 Step -1
            If Cells(b, 11).Value = "Return" Then
                Rows(b).EntireRow.Delete
            End If
    Next
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

I am trying to understand why you are using a For...Next loop instead of something like this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = Falste
    If Not Intersect(Target, Range("U:U")) Is Nothing Then
        If Target.Value = "Admit" Then
            Target.EntireRow.Copy Sheets("Admitted").Cells(Rows.Count, 1).End(xlUp)(2)
            Target.EntireRow.Delete
        End If
    End If
Application.EnableEvents = True
End Sub

If either sheets 4 or 5 are named 'Admitted' then your macro in the first sheet is triggering the macro for Return at the time the copied data is posted to the Admitted sheet.
To remedy that, you can use the Application.EnableEvents statements as I have done in the macro above, or just use the macro above in place of the one that is giving you a problem.