Avatar of Matt Mali
Matt Mali
 asked on

Worksheet change event using a button

Hi gurus..

The attached workbook has multiple macros. All macros works as intended. Neeraj from this site helped me with the change vent macros.  Requesting a change in the worksheet change event macro.

This is a suggestion from the users of the worksheet.

Instead of allocating each task, users are suggesting first to select the Planners from the drop down list in column N and after completing the selection, click the ''allocate task'' button to send all the tasks in one go.

Not sure whether to separate the auto date population macro, if task allocation macro need to undergo major changes.

Regards
Team-2.xlsm
Microsoft OfficeMicrosoft ExcelMicrosoft ApplicationsVBA

Avatar of undefined
Last Comment
Subodh Tiwari (Neeraj)

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Subodh Tiwari (Neeraj)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Matt Mali

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

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

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??
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Subodh Tiwari (Neeraj)

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

Open in new window

Matt Mali

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

Open in new window


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

Open in new window


Please let me know if I am doing it right.

Regards
Subodh Tiwari (Neeraj)

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

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Matt Mali

ASKER
Thanks Neeraj. My tweaked code is showing a Compile error-Next Without For. Not sure what to do
SOLUTION
Subodh Tiwari (Neeraj)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Matt Mali

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.
Subodh Tiwari (Neeraj)

You're welcome Matt! Glad your issue is resolved.
Your help has saved me hundreds of hours of internet surfing.
fblack61