How Do I Move Row to Different Sheet based on Selected Value

[ApolloCarrierServ]

I am trying to create a call sheet that organizes Active Leads. I am wanting to move a customer to a "Do Not Call" sheet if that selection is made. That way I have 2 separate sheets 1 for active leads and 1 for Do Not Call. But If a customer on the Do Not Call sheet changes their mind, I would like to move them back to the active Leads list.

On the Active Leads sheet I have a Data Filter with the selections of "HOT", "Follow Up" or "Do Not Call" in column C. If "Do Not Call" is selected that row of information is moved to the Do Not Call Sheet and deleted from the Active Leads sheet.

I want to be able to do the same from the Do Not Call Sheet if it is changed to "HOT" or "Follow Up". For whatever reason when I try to use the same VBA to move them back to the Active Leads sheet it does not work.



Here is the VBA to move data to the Do Not Call Sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Application.EnableEvents = False

'If Cell that is edited is in column C and the value is Do Not Call then
If Target.Column = 3 And Target.Value = "Do Not Call" Then
'Define last row on Do Not Call worksheet to know where to place the row of data
LrowDoNotCall = Sheets("Do Not Call").Cells(Rows.Count, "C").End(xlUp).Row
'Copy and paste data
Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Do Not Call").Range("A" & LrowDoNotCall + 1)
'Delete Row from Active Leads
Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp


End If

End Sub

Thanks for the help!

 

[mumps]

Place this macro in the code module for the "Active Leads" sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Dim desWS As Worksheet
    Set desWS = Sheets("Do Not Call")
    If Target.Value = "Do Not Call" Then
        Range("A" & Target.Row).Resize(, 21).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    End If
    Application.EnableEvents = True
End Sub

Place this macro in the code module for the "Do Not Call" sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Dim desWS As Worksheet
    Set desWS = Sheets("Active Leads")
    If Target.Value = "Hot" Or Target.Value = "Follow Up" Then
        Range("A" & Target.Row).Resize(, 21).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    End If
    Application.EnableEvents = True
End Sub

 

[ApolloCarrierServ]

Thank you for the reply!
The module is working, but it is overwriting data when it changes to the new sheet instead of adding to the next blank row. How would I add it to the bottom so I'm not losing information?

 

[mumps]

It should not be overwriting any data. The macro copies the data and pastes it to the first blank row at the bottom. Can you post a screen shot of what your data looks like in both sheets? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[ApolloCarrierServ]

https://www.dropbox.com/s/tryf5oaxu04qpek/Leads Sheet test.xlsm?dl=0

Here is a link to my sheet.
Thanks again for your help!

 

[mumps]

You have to make sure that column A in "Active Leads" is populated (not blank).

 

[ApolloCarrierServ]

Oh yes I see that now. Thank you! Not all entries will have a date populated in Column A if they are a new lead that has not yet been contacted. That's why it was removing information.

 

[mumps]

For new leads that have not yet been contacted, instead of date, just enter something like N/A in column A so that there are no blanks in that column.

 

[ApolloCarrierServ]

I actually moved the customer to Column A and date to Column D. It works perfectly now. Thanks you so much for your help.

 

[mumps]

You are very welcome.