Worksheet change event using a button

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Thank you very much Neeraj.. Wasnt able to try the macro yet.. Down with flu..will let you know soon

No problem Matt! Take proper rest and get well soon.

ASKER

Thanks Neeraj..The macros are working in my home computer. However when I try to do this in the office setting, a pop up box asking me to unprotect the destination sheet. The destination sheet vba can be found in

https://www.experts-exchange.com/questions/29098093/Autopopulating-cells-not-working-in-different-situations.html

The vba in the destination sheet should be unprotecting the sheet by itself which is not working in this situation.

Any thoughts??

Which code is not working if the sheet is protected? Is it writing the date in column L or transferring the data into other workbook?

If this is sheet change event, please replace the sheet change event code with the following one and change the password in line#1.

Const PW As String = "Matt"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    ThisWorkbook.ActiveSheet.Unprotect PW
    If Not Intersect(Target, Range("C6:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        r = Target.Row
        If Target <> "" Then
            Application.EnableEvents = False
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
            Application.EnableEvents = True
        End If
    End If
    ThisWorkbook.ActiveSheet.Protect PW
Application.ScreenUpdating = True
End Sub

ASKER

Thanks Neeraj. Transferring the data into other workbook is not working. Tasks are not moving from the Team level to the employee level. Whenever task allocation button is pressed, a pop up box will come up as a runtime error asking to unprotect the employee level sheet.

In the above macro, the sheet hiding change based on criteria is not included.

Const PW As String = "Matt"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Skip
ThisWorkbook.ActiveSheet.Unprotect PW
If Not Intersect(Target, Range("C6:C3000")) Is Nothing Then
    For Each cell In Target.Columns(1).Cells
        r = cell.Row
        If Cells(r, "C") <> "" Then
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
        End If
    Next cell
ElseIf Not Intersect(Target, Range("AA6:AA3000")) Is Nothing Then
    If Target <> "" Then
        If LCase(Target.Value) = "completed" Then
            Target.EntireRow.Hidden = True
        End If
    End If
End If
ThisWorkbook.ActiveSheet.Protect PW
Skip:
Application.EnableEvents = True
End Sub

This was the code previously sent by you.
With my limited knowledge, I have added the added the second change event in to your new code as follows

Const PW As String = "Matt"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    ThisWorkbook.ActiveSheet.Unprotect PW
    If Not Intersect(Target, Range("C6:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        r = Target.Row
        If Target <> "" Then
            Application.EnableEvents = False
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
            Application.EnableEvents = True
        End If
    End If
    Next cell
ElseIf Not Intersect(Target, Range("AA6:AA”& Range("AA" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    If Target <> "" Then
        If LCase(Target.Value) = "completed" Then
            Target.EntireRow.Hidden = True
        End If
    End If
End If
ThisWorkbook.ActiveSheet.Protect PW
Application.ScreenUpdating = True
End Sub

Please let me know if I am doing it right.

Regards

Earlier you said that you don't need the hide functionality in the sheet change event and requested to delete it. Isn't it?

Anyways, it seems you tweaked it correctly. Did you not test it after tweaking it?

Also, if the unprotect prompt is being appeared when you transfer the data to another workbook. The code which handles this functionality is placed on Module1 and called "AllocateTasks" which you run by hitting a button.

All you need is, replace the existing code "AllocateTasks" on Module1 with the following one. See if that works for you.

Const PW As String = "Matt"
Sub AllocateTasks()
Dim swb As Workbook, dwb2 As Workbook
Dim sws As Worksheet, dws2 As Worksheet
Dim dwbPath As String, Team As String, TeamNo As String, Task As String
Dim lr As Long, i As Long

Application.ScreenUpdating = False

Set swb = ThisWorkbook
Set sws = swb.Sheets("Task Allocation")
lr = sws.Cells(Rows.Count, "N").End(xlUp).Row
If lr < 6 Then
    MsgBox "No Tasks were found to be allocated.", vbExclamation, "Tasks Not Found!"
    Exit Sub
End If

For i = lr To 6 Step -1
    If sws.Cells(i, "N").Value <> "" Then
        Task = sws.Cells(i, "N").Value
        TeamNo = ExtractNumber(Task)
        dwbPath = "C:\Secured\Planner Level\Planner " & TeamNo & "\Planner " & TeamNo & ".xlsm"
        On Error Resume Next
        Set dwb2 = Workbooks("Planner " & TeamNo & ".xlsm")
        On Error GoTo 0
    
        If dwb2 Is Nothing And Dir(dwbPath) <> "" Then
            Set dwb2 = Workbooks.Open(dwbPath, False)
        End If
        
        If Not dwb2 Is Nothing Then
            Set dws2 = dwb2.Sheets(1)
            dws2.Unprotect PW
            sws.Range("C" & i & ":K" & i).Copy
            dws2.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
            sws.Range("C" & i & ":O" & i).Delete shift:=xlUp
        End If
    End If
Next i
dws2.Protect PW
End Sub

ASKER

Thanks Neeraj. My tweaked code is showing a Compile error-Next Without For. Not sure what to do

SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Thanks Neeraj. I removed the password option and is working well. I think I should leave it that way. Thanks heaps for all your advice and input.