Macro for Copying One Cell to another on Selection of Picklist

[Niv_Shah]

Hi Guys,
I have shared the link for my Workbook"Sample_NS", please see the below link.
https://drive.google.com/file/d/0BwN-9A9jHDNcXzU4R0ZQVFZOVnM/view?usp=sharing

In the "Sample_NS" workbook there are two worksheets "Ashok" and "Shruti"
both Sheet contains Task Owner and Team Member where Owner and Team Member is the Picklist

Now what I want is, on the Selection of Team member I want to copy the task in Relevant team members sheet

For E.g. In Sheet "Ashok" lets say for Task "T1" we have selected owner as "Nirdesh" and Team Member as "Shruti" so the Task "T1" should be copied to the sheet "Shruti"

Please advise
Thanks
Nirav

 

[Niv_Shah]

Hi ,
Thanks for the quick replay

Nirav

 

[Fishboy]

Hi ,
Thanks for the quick replay

Nirav

Happy to help

 

[Niv_Shah]

Hi Fishboy,
Sorry to bother you again and again. I need to do something more in the XLS. I have shared the link of modified Workbook "Sample_NS_V1", please see the below link.
https://drive.google.com/file/d/0BwN-9A9jHDNcVV9jejhRSktKWDQ/view?usp=sharing


As you already know in the "Sample_NS_V1" workbook there are two worksheets "Ashok" and "Shruti" but now there is one more sheet added named "AM". The Sheet contains Task, Task Owner, Team Member, Optional Picklist, Data 1 and Data 2 where Owner, Team Member, and Optional Picklist is the Picklist


Now what I want is, on the Selection of Owner, Team Member, and Optional Picklist, I want to copy the task in Relevant Owner, Team Members, and AM sheet. But as the name suggest the Optional Picklist is the optional one. If one didn't select the value then the Task should be copied to the Team Member and if the value is selected the task will be copied to both Team Members and Optional Value sheets.


For E.g. In Sheet "Hemali" let's say for Task "T1" we have selected owner as "Nirav", Team Member as "Ashok" and Optional Picklist as "AM", so the Task "T1" should be copied to the sheet "Ashok" as well as the sheet "AM".
If the "AM" is not selected then the Task "T1" should be copied to the sheet "Ashok" only.
If Owner is selected as "Nirav" and the Optional Picklist is selected as "AM" then the task should be copied to "AM" sheet.
also, I want to know that how can I do the Exception Handling in Macro


Please advise
Thanks
Nirav

 

[Fishboy]

Hi again Nirav,

I have updated the Worksheet_Change as follows (changes highlighted in red):

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRow As Long, wsLastRow As Long, opLastRow As Long
    Dim ws As Worksheet
    Dim TeamName As String


    LastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1


    If Not Intersect(Target, Range("C2:C" & LastRow)) Is Nothing Then
        If Target.Value <> "" Then
            TeamName = Target.Value
            Set ws = Sheets(TeamName)
            If ws.Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A40").EntireRow
            Else
                wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A" & wsLastRow).EntireRow
            End If
        End If
    End If
    
    If Not Intersect(Target, Range("D2:D" & LastRow)) Is Nothing Then
        If Target.Value <> "" Then
            If Sheets("AM").Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A40").EntireRow
            Else
                opLastRow = Sheets("AM").Cells(Rows.Count, "A").End(xlUp).Row + 1
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A" & wsLastRow).EntireRow
            End If
        End If
    End If
    
End Sub

Does that do what you need?

 

[Niv_Shah]

Hey,
Thank you very much for your quick reply. You are really a lifesaver for me.
You have understood correctly, but after selecting the AM on the second time it is giving me the error.

I also wanted to know that is it possible update the record every time it changed.For. Ex when I select Nirav and Team Member as Ashok the Ashok sheet will have the T2 Task with the Owner and Team Member, but after that, I am selecting the AM for the same task. then the details Nirav Ashok and AM will be copied to AM sheet.
Now is it possible to add AM in the Ashok's sheets also?


I am sorry if I am confusing you. Please revert me back if need more explanation.


Thanks
Nirav

 

[Fishboy]

Hi Nirav,

Can you give me some more details about the error you are receiving so I can try and replicate / understand the cause?

With regards to your newer query, to be honest it is a little confusing. If you are able explain further then I may be able to assist.

 

[Niv_Shah]

Hi Fishboy,
The Error is "Run-time error '1004': Application-defined or object-defined error"

What I need is when one One Selects the Owner as well as Team Leader the row should copy to the Team members sheet, or if one have selected the Owner, Team Member, and the third picklist then the row should copy to the Team members as well as AM sheet.

Now that is happening with the current code, but what I want is when I select the Team Member for Task, let's say for T1 Task I have selected the Owner as Nirav and Team Member as Ashok, then the entire row is copied to Ashok which is ok. but after that, I am selecting the third picklist AM for the task T1 and the AM sheet will have the entire row copied, but the problem is Task T1 data in Ashok's sheet is not updated.


I want the data to be updated if the same row is changed multiple times.


Thanks
Nirav

 

[Fishboy]

Right, so I cannot reproduce the error you are getting. Run-time error '1004' usually suggests an issue with either sheet names not being correctly spelt or by having code in the wrong module. In theory so long as your sheet names are exactly as they are in the example you shared with me then it shouldn't be that. Also a Worksheet_Change macro only runs when in a worksheet module, so again it shouldn't be that either. Either way, I certainly do not have the same issue with the example workbook you shared with me, so I have uploaded my updated and working copy HERE.

In the updated version I have just shared, I believe I have managed to handle the scenario you outlined above. So for example, if you select Team and team member without optional picklist then the correct team sheet is updated. If you then go back and add an picklist option then the existing entry on the team sheet is updated accordingly as well as the AM sheet updating.

Likewise, if you put a picklist option in without any team details the AM sheet updates. If you go back and add team details to that task then the AM sheet updates correctly, and then the correct team sheet updates.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, wsLastRow As Long, opLastRow As Long
Dim ws As Worksheet
Dim TeamName As String, FindString As String
Dim Rng As Range, cRange As Range


If Target.Cells.Count > 1 Then Exit Sub


LastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1


If Not Intersect(Target, Range("C2:C" & LastRow)) Is Nothing Then
    If Target.Value <> "" Then
        If Target.Offset(0, 1).Value = "" Then
            TeamName = Target.Value
            Set ws = Sheets(TeamName)
            If ws.Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A40").EntireRow
            Else
                wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A" & wsLastRow).EntireRow
            End If
        Else
            FindString = Target.Offset(0, -2).Value
            Set ws = Sheets(Target.Offset(0, 1).Value)
            wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
            Set cRange = ws.Range("A40:A" & wsLastRow)
            With cRange
                Set Rng = .Find(What:=FindString, _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
                    If Not Rng Is Nothing Then
                        ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A" & Rng.Row).EntireRow
                    End If
            End With
            TeamName = Target.Value
            Set ws = Sheets(TeamName)
            If ws.Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A40").EntireRow
            Else
                wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A" & wsLastRow).EntireRow
            End If
        End If
    End If
End If


If Not Intersect(Target, Range("D2:D" & LastRow)) Is Nothing Then
    If Target.Value <> "" Then
        If Target.Offset(0, -1).Value = "" Then
            If Sheets("AM").Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A40").EntireRow
            Else
                opLastRow = Sheets("AM").Cells(Rows.Count, "A").End(xlUp).Row + 1
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A" & wsLastRow).EntireRow
            End If
        Else
            TeamName = Target.Offset(0, -1).Value
            FindString = Target.Offset(0, -3).Value
            Set ws = Sheets(TeamName)
            wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
            Set cRange = ws.Range("A40:A" & wsLastRow)
            With cRange
                Set Rng = .Find(What:=FindString, _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
                    If Not Rng Is Nothing Then
                        ActiveSheet.Range("A" & Target.Row).EntireRow.Copy ws.Range("A" & Rng.Row).EntireRow
                    End If
            End With
            If Sheets("AM").Range("A40") = "" Then
                ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A40").EntireRow
            Else
                FindString = Target.Offset(0, -3).Value
                Set ws = Sheets(Target.Value)
                wsLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                Set cRange = ws.Range("A40:A" & wsLastRow)
                With cRange
                    Set Rng = .Find(What:=FindString, _
                                    After:=.Cells(1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlPrevious, _
                                    MatchCase:=False)
                        If Rng Is Nothing Then
                            opLastRow = Sheets("AM").Cells(Rows.Count, "A").End(xlUp).Row + 1
                            ActiveSheet.Range("A" & Target.Row).EntireRow.Copy Sheets("AM").Range("A" & wsLastRow).EntireRow
                        End If
                End With
            End If
        End If
    End If
End If
    
End Sub

 

[Niv_Shah]

Thanks Fishboy

It works fine Is there any way to mark this answer as best answer, so it would be helpful for others

Thanks again
Nirav Shah

 

[Fishboy]

Thanks Fishboy

It works fine Is there any way to mark this answer as best answer, so it would be helpful for others

Thanks again
Nirav Shah

Hi Nirav, glad to hear we got there in the end

Thanks for the positive feedback. Pressing the Like button (as you have) is the only real way of signifying a best answer.

Anyways, happy to help.