Macro Help - Moving Rows From One Sheet to Another

[lsualum2010]

Hey guys,

I would love some help building a macro. I have a list of info in a sheet named "Active Leads". I want to be able to type "x" into the cell in column H on Active Leads and the entire row be moved to the next available row on another sheet named "Past Leads".

Is that possible? Do you guys need more info?

Thank you!

 

[Mentor82]

HI,
Try this.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws as worksheet
Set ws= worksheets("Past Leads")
    If Target.column=8 and lcase(target.value)="x" then
       
        Rows(target.row).cut
       Ws.rows(ws.range(rows.count,1).end(xlup).row+1).paste
    End If

Application.cutcopymode=false
Set ws=nothing
End Sub

[\CODE]

 

[JLGWhiz]

Put in the worksheet code module.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If LCase(Target) = "x" Then
            Target.EntireRow.Cut Sheets("Past Leads").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    End If
Application.EnableEvents = True
End Sub

 

[lsualum2010]

When I enter (either) code in the module code box, I don't have any macros to run (F5) after I close the box. Is that normal? Either way the code doesn't do anything in my workbook- although I'm 100% sure that's based on user error. I just don't know where I'm messing up.

 

[My Aswer Is This]

Try this:

You need to install the script on sheet named "Active Leads"

Like this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  1/8/2019  7:06:04 PM  EST
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Past Leads").Cells(Rows.Count, "H").End(xlUp).Row + 1
    If LCase(Target) = "x" Then Target.EntireRow.Cut Sheets("Past Leads").Rows(Lastrow)
End If
End Sub

 

[My Aswer Is This]

And you must enter a lower case x into column H for the script to run.

 

[lsualum2010]

Try this:

You need to install the script on sheet named "Active Leads"

Like this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  1/8/2019  7:06:04 PM  EST
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Past Leads").Cells(Rows.Count, "H").End(xlUp).Row + 1
    If LCase(Target) = "x" Then Target.EntireRow.Cut Sheets("Past Leads").Rows(Lastrow)
End If
End Sub

Wow. Worked like a charm. THANK YOU.

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Wow. Worked like a charm. THANK YOU.

 

[JLGWhiz]

And you must enter a lower case x into column H for the script to run.

By using the 'LCase(Target) = x' it makes the entry case insensitive. The user can enter upper or lower case in the target cell and it will compare to lower case.