Macro removes data validation from cell

[JCRangers]

Hi,

I have an excel sheet to track project status. I've created a Macro that moves the a row from Sheet1 to Sheet2 when 'Complete' is selected from data validation drop down. The problem is, when the row is moved to sheet 2, the now empty row loses all it's data validation. Is there any way to move a row from Sheet1 to Sheet2 without removing the cell data validation in throughout the row?

Thanks,
Jason

 

[Richard U]

Please post the macro so that we can see it

 

[JCRangers]

Please post the macro so that we can see it

Thanks Richard:

Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("In Progress").UsedRange.Rows.Count
lastrow2 = Worksheets("Complete").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
For r = lastrow To 2 Step -1
If Range("J" & r).Value = "Complete" Then
Rows(r).Cut Destination:=Worksheets("Complete").Range("A" & lastrow2 + 1)
lastrow2 = lastrow2 + 1
Else:
End If
Next r
Application.ScreenUpdating = True

End Sub
_________________________
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J3:J1000")) Is Nothing Then
Call MM1
End If

 

[Richard U]

Instead of.....

Rows(r).Cut Destination:=Worksheets("Complete").Range("A" & lastrow2 + 1)

Try....

Worksheets("Complete").Range("A" & lastrow2 + 1).value = Rows(r).value
Rows(r).value = ""

If that doesn't work, let me know, and I'll look into it more deeply. I'm leaving work right now.

 

[JCRangers]

Instead of.....

Rows(r).Cut Destination:=Worksheets("Complete").Range("A" & lastrow2 + 1)

Try....

Worksheets("Complete").Range("A" & lastrow2 + 1).value = Rows(r).value
Rows(r).value = ""

If that doesn't work, let me know, and I'll look into it more deeply. I'm leaving work right now.

Thanks Richard - I got a syntax error when running the code with a highlighted indicator on 'Sub MM1 ()'

 

[JCRangers]

Thanks Richard - I got a syntax error when running the code with a highlighted indicator on 'Sub MM1 ()'

Richard - Please disregard, it worked! I made a made an error when transposing. Now that that is taken care of, I have one more question - when the row is removed from the Sheet 1 and delivered to Sheet 2, a blank line is left in it's place. Is there a way to move it and get rid of the blank line? I should have thought of this first because removing the blank line would've also solved the format issue =\

 

[Richard U]

yes, you can just....


Rows(r).delete

 

[JCRangers]

yes, you can just....


Rows(r).delete

Excellent - thanks for taking the time to help a rookie!!! everything worked perfect. Have a great one!

 

[JCRangers]

Excellent - thanks for taking the time to help a rookie!!! everything worked perfect. Have a great one!

Rich Sorry - Gotta check back one more time here. Not sure where I went wrong but the destination sheet is only capturing the first cell of the row. Current overall code:

Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("In Progress").UsedRange.Rows.Count
lastrow2 = Worksheets("Complete").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
For r = lastrow To 2 Step -1
If Range("J" & r).Value = "Complete" Then
Worksheets("Complete").Range("A" & lastrow2 + 1).Value = Rows(r).Value
Rows(r).Delete
lastrow2 = lastrow2 + 1
Else:
End If
Next r
Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J3:J1000")) Is Nothing Then
Call MM1
End If
End Sub

 

[MARK858]

It is because if doing a .Value = .Value your ranges should be the same size. Although you really should restrict the number of columns as an entire row is overkill see if the below (untested) works...

Sub MM1()
    Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
    Application.ScreenUpdating = False
    lastrow = Worksheets("In Progress").UsedRange.Rows.Count
    lastrow2 = Worksheets("Complete").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
        If Range("J" & r).Value = "Complete" Then
            With Rows(r)
                Worksheets("Complete").Range("A" & lastrow2 + 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
            Rows(r).Delete
            lastrow2 = lastrow2 + 1
        Else:
        End If
    Next r
    Application.ScreenUpdating = True
End Sub