• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Code edit - checking cell and adding data before running

Hi,
Can anyone help edit this code...

What id like is this... If selection is 'Completed' check if cell in column 'U' is 'Y' and cell in column 'V' is 'Y'.... if they are true allow the rest of the code to run. If there is no 'Y' in either column the transfer can go ahead, if only a Y in U then popup to ask for the Y before going ahead.

I hope this makes sense its boggling my mind

Code:
ay = Target.Row
    ax = Target.Column
    tv = Target.Value
    If ax = 21 And ay > 1 And tv <> Empty And tv <> ActiveSheet.Name And ActiveSheet.Cells(ay, 1) <> Empty And (tv = "Issues" Or tv = "Completed") Then
        On Error Resume Next
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        R = 1
        With Sheets(tv)
            Do
                R = R + 1
            Loop Until .Cells(R + 1, 1) = Empty
            R = R + 1
        End With
        If tv = "Completed" Then Sheets(tv).Unprotect "KPS"
              
        DOP = False
        With ActiveSheet
            If .ProtectContents Then
                .Unprotect "KPS"
                DOP = True
            End If
            .Range("A" & ay & ":U" & ay).Copy
            Sheets(tv).Range("A" & R).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            If Err.Number = 0 Then
                .Range("A" & ay & ":U" & ay).Delete shift:=xlUp
            Else
                MsgBox "Couldn't Move That Row To " & tv & "!"
            End If
          
            If DOP Then .Protect "KPS", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
        AllowFiltering:=True
        End With
      
        If tv = "Completed" Then Sheets(tv).Protect "KPS", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True
      
        Sheets("In Progress").Select
        Application.EnableEvents = True
        Application.ScreenUpdating = True
                            
    End If
End Sub
 
Last edited:
Without sample workbook, it'll be difficult for us to help you. Please upload desensitized workbook, that accurately represent your actual workbook (i.e. same data type and column structure etc).
 
Back
Top