Change cells based on selection from a drop down menu

[grnmchn]

Hi - I have a macro that is ALMOST working the way that I want it to, but need a little help.

The spreadsheet is a checklist with a list of tasks down column A (rows 4 through 43), a place for a person to enter their name in column B and then a simple two choice drop down list in column C ("Open" or "Completed"). When the person chooses "Open" from the drop down (or the cell is left blank), columns D and E are instructed to be blank. When the person chooses "Completed" from the drop down, column D = Now() and column E = Environ$("UserName").

The same logic is repeated in columns F-I and J-M for a first level review and a second level review.

The problem that I am having is that when the first level reviewer makes a selection from the drop down in column G, the macro properly inputs the sign-off data in columns H and I, but it overwrites the original results (from the person who completed the task) in columns D and E. The same thing happens when the second level reviewer makes their selection from the drop down list in column K - the results from the original completer (in columns D and E) and first level reviewer (in columns H and I) are overwritten - I want them to stay the same.

The macro is applied by row, and I want it to be applied by independent events (selections from the drop down lists in columns C, G and K). Thanks in advance for the help!

Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect

Dim R As Range, Part As Range
Set Part = Intersect(Target, Range("c4:c43,g4:g43,k4:k43"))

If Not Part Is Nothing Then

Application.EnableEvents = False

For Each R In Part

If Range("c" & R.Row) = "Completed" Then
Range("d" & R.Row).Value = Now()

Range("e" & R.Row).Value = Environ$("UserName")
Else
Range("d" & R.Row).Value = ""

Range("e" & R.Row).Value = ""

End If

If Range("g" & R.Row) = "Completed" Then
Range("h" & R.Row).Value = Now()

Range("i" & R.Row).Value = Environ$("UserName")
Else
Range("h" & R.Row).Value = ""

Range("i" & R.Row).Value = ""

End If

If Range("k" & R.Row) = "Completed" Then
Range("l" & R.Row).Value = Now()

Range("m" & R.Row).Value = Environ$("UserName")
Else
Range("l" & R.Row).Value = ""

Range("m" & R.Row).Value = ""

End If

Next

Application.EnableEvents = True

End If

ActiveSheet.Protect

End Sub

 

[Fluff]

Untested but try

Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    ActiveSheet.Unprotect
    
    If Not Intersect(Target, Range("c4:c43,g4:g43,k4:k43")) Is Nothing Then
    
        Select Case Target.Column
            Case 3
                If Target.Value = "Completed" Then
                    Target.Offset(, 1).Value = Now()
                    Target.Offset(, 2).Value = Environ$("UserName")
                Else
                    Target.Offset(, 1).Resize(, 2).Value = ""
                End If
            Case 7
                If Target.Value = "Completed" Then
                    Target.Offset(, 1).Value = Now()
                    Target.Offset(, 2).Value = Environ$("UserName")
                Else
                    Target.Offset(, 1).Resize(, 2).Value = ""
                End If
            Case 11
                If Target.Value = "Completed" Then
                    Target.Offset(, 1).Value = Now()
                    Target.Offset(, 2).Value = Environ$("UserName")
                Else
                    Target.Offset(, 1).Resize(, 2).Value = ""
                End If
        End Select
    
Application.EnableEvents = True
      
    ActiveSheet.Protect

End Sub

 

[wideboydixon]

I think you can simplify this:

Sub Worksheet_Change(ByVal Target As Range)

Dim R As Range, Part As Range

Set Part = Intersect(Target, Range("c4:c43,g4:g43,k4:k43"))

ActiveSheet.Unprotect

If Not Part Is Nothing Then
    Application.EnableEvents = False
    For Each R In Part
        If R.Value = "Completed" Then
            R.Offset(0, 1).Value = Now()
            R.Offset(0, 2).Value = Environ$("UserName")
        Else
            R.Offset(0, 1).Value = ""
            R.Offset(0, 2).Value = ""
        End If
    Next
    
    Application.EnableEvents = True
End If

ActiveSheet.Protect

End Sub

WBD

 

[Fluff]

@WBD
Quite right, I've definitely over complicated things for no reason.
A simpler version of my code is

Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    ActiveSheet.Unprotect
    
    If Not Intersect(Target, Range("c4:c43,g4:g43,k4:k43")) Is Nothing Then

        If Target.Value = "Completed" Then
            Target.Offset(, 1).Value = Now()
            Target.Offset(, 2).Value = Environ$("UserName")
        Else
            Target.Offset(, 1).Resize(, 2).Value = ""
        End If
    
Application.EnableEvents = True
      
    ActiveSheet.Protect

End Sub

 

[grnmchn]

Thanks much to both of you. It looks like either option will work. I appreciate it!

 

[Fluff]

Glad we could help & thanks for the feedback