Macro to move a row to a different worksheet when the using a drop down

[Wraithv]

I am looking for a macro to cut a row from a worksheet titled Open QN's to a worksheet titled Closed QN's when the drop down in column A is changed to closed, in excel 2003 (all they use at work). I found a macro on these forums that looks like it will do exactly what I want, but when I copy it into the worksheet and adjust it to my needs it does nothing. It does not give me any errors, just sits there.

 

[GRTorres]

Hello wraith, did you try and change event macro?
If your drop down is on Open QN's place try this on your VBAproject sheet for Open QN'S.

Public Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1"  ' change to your drop down cell
      If Target.value = "closed" Then
          'Place code here
      End if
End IF
End Sub

 

[Michael M]

You could post the code that "does exactly waht I want"
maybe it's a simple change to an event macro as GRTorres mentioned

 

[Wraithv]

Sorry, I ended up trying another code that I found that makes more sense to me. Same result though, so here is the code.

Sub MoveClosed()

Dim xrow As Long
xrow = 2
Sheets("Open QN's").Select
Dim loastrow As Long


Do Until xrow = lastrow + 1
    ActiveSheet.Cells(xrow, 1).Select
    If ActiveCell.Text = "Closed" Then
        Selection.EntireRow.Cut
        Sheets("Closed QN's").Select
        ActiveSheet.Range("A2").End(x1down).Select
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        Selection.Copy
        Selection.PasteSpecial Paste:=x1PasteValues
        Application.CutCopyMode = False
        Sheets("Open QN's").Select
        ActiveCell.Select
        Selection.EntireRow.Delete
        xrow = xrow - 1
    End If


xrow = xrow + 1
Loop
End Sub

And if GRTorres, where would I place your addition in this code.

 

[Michael M]

Try this....UNTESTED

Sub MoveClosed()
Dim xrow As Long, lr As Long, lr2 As Long
lr = Sheets("Open QN's").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Closed QN's").Cells(Rows.Count, "A").End(xlUp).Row
xrow = 2
    With Sheets("Open QN's")
        Do Until xrow = lr + 1
                If ActiveCell.Text = "Closed" Then
                    Rows(xrow).Cut
                    Sheets("Closed QN's").Range("A" & lr2 + 1).PasteSpecial Paste:=x1PasteValues
                End If
            xrow = xrow + 1
        Loop
    End With
Sheets("Open QN's").Rows(xrow & ":" & lr).Delete
End Sub

To run the code Press ALT + F8 and select the "MoveClosed" macro from the list and press RUN

 

[Michael M]

Finally got back to the machine...and had to modify slightly

Sub MoveClosed()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Open QN's").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Closed QN's").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Open QN's").Activate
        For r = 2 To lr
                If Range("A" & r).Value = "Closed" Then
                    Rows(r).Copy
                    Sheets("Closed QN's").Rows(lr2 + 1).PasteSpecial Paste:=xlPasteValues
                End If
                Rows(r).Delete
        Next r
End Sub

 

[Michael M]

Another mod

Sub MoveClosed()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Open QN's").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Closed QN's").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Open QN's").Activate
        For r = 2 To lr
                If Range("A" & r).Value = "Closed" Then
                    Rows(r).Copy
                    Sheets("Closed QN's").Rows(lr2 + 1).PasteSpecial Paste:=xlPasteValues
                End If
        Next r
        For r = lr To 2 Step -1
                If Range("A" & r).Value = "Closed" Then Rows(r).Delete
        Next r
End Sub

.......and I'm away from the machine, again !!

 

[Wraithv]

Ok, so my brother-in-law got the original code to work on his computer, both are using excel 2003. All I can this is it is something with this computer that is messed up, not the code.