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
Matt MaliAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Hi Matt,

I have replace the Sheet Change Event with the following code.

Sheet Change Event Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    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
Application.ScreenUpdating = True
End Sub

Open in new window


I have placed a code called "AllocateTasks" on Module1 and assigned this code to the button "Allocate Tasks". You may click this button to run the code.

Code on Module1:

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)
            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
End Sub

Open in new window


Please find the attached for your reference.
Team-3.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Matt MaliAuthor Commented:
Thank you very much Neeraj.. Wasnt able to try the macro yet.. Down with flu..will let you know soon
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
No problem Matt! Take proper rest and get well soon.
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Matt MaliAuthor Commented:
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??
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

0
Matt MaliAuthor Commented:
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
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

0
Matt MaliAuthor Commented:
Thanks Neeraj. My tweaked code is showing a Compile error-Next Without For. Not sure what to do
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Remove line#17 from your tweaked code i.e. remove Next cell
0
Matt MaliAuthor Commented:
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.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Matt! Glad your issue is resolved.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.