VBA Code Alteration

[wlbamc]

I have the following code which turns the cells red if they are not completed when you choose from the dropdown in Column Z. I want to change this to dropdown in column P. Any help please

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Intersect(Target, Range("A:Z")) Is Nothing Then Exit Sub
    On Error GoTo endit
    Application.EnableEvents = False
    Select Case Target.Column
        Case Is = 26
            If WorksheetFunction.CountA(Range("A" & Target.Row).Resize(, 25)) < 25 Then
                Range("A" & Target.Row).Resize(, 25).SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3
                MsgBox ("Please enter data in the red cells.")
                Application.EnableEvents = True
                Exit Sub
            End If
            If Target.Value = "No LTC input" Then
                Target.EntireRow.Copy Worksheets("Inactive").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "Deceased" Then
                Target.EntireRow.Copy Worksheets("Inactive").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "D2A (Own Home)" Then
                Target.EntireRow.Copy Worksheets("D2A").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "D2A (Care Home)" Then
                Target.EntireRow.Copy Worksheets("D2A").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "LTC Team withdrew prior to Discharge" Then
                Target.EntireRow.Copy Worksheets("Inactive").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "Discharged to Own Home" Then
                Target.EntireRow.Copy Worksheets("Inactive").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            ElseIf Target.Value = "Discharged to Care Home" Then
                Target.EntireRow.Copy Worksheets("Inactive").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Target.EntireRow.Delete
            End If
        Case Is <= 19
            If Target <> "" Then
                Target.Interior.ColorIndex = xlNone
            End If
    End Select
endit:
     Application.EnableEvents = True
     Application.ScreenUpdating = True
End Sub

 

[Legacy 143009]

Try changing this line:

Case Is = 26

to this:

Case Is = 16

 

[wlbamc]

Thank you, I have got the red boxes to stop at P by also changing the 25's to 15 but it is now not moving to the completed tab, any ideas please

 

[Joe4]

I think you will need to either change or elimiate this part:

        Case Is <= 19
            If Target <> "" Then
                Target.Interior.ColorIndex = xlNone
            End If

As 16 is less than 19, so changes to coluimn P would cause that part to run too!

 

[wlbamc]

Thank you, I have got the red boxes to stop at P by also changing the 25's to 15 but it is now not moving to the completed tab, any ideas please

Don't worry all sorted thanks