VBA mod

[dantheram]

Hi all,

can someone help me to mod this so that when the rows identified are moved to another sheet the subsequent blank row is deleted from the source table, please?

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

 

[Logit]

.

Sub DelEmptyRows()
    Dim lr As Long
    Application.ScreenUpdating = False    '\/Change number 1 below to correspond to affected column.
    lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row '<----- Change to actual sheet name
    With Range("A1:A" & lr)                                   '<-- Change to corresponding row
        .Replace " ", "", xlWhole                               '<-- Currently checking for number 0. Edit as required
        .SpecialCells(4).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Maybe

Sub Move_Closed()
Dim Check As Range, Rng As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Open").UsedRange.Rows.Count
lastrow2 = Worksheets("Completed").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
        If Range("E" & r).Value = "Y" Then
            Rows(r).Cut Destination:=Worksheets("Completed").Range("A" & lastrow2 + 1)
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next r
    If Not Rng Is Nothing Then Rng.Delete
Application.ScreenUpdating = True
End Sub

 

[dantheram]

this appears to work fantastically - thank you

 

[Logit]

.
You are welcome. Thank you for the mention.

 

[dantheram]

this appears to work fantastically - thank you

it appears i spoke to soon - the code does not function when there are multiple rows moved over, the blank rows are not deleted in these circumstances

any ideas how to fix this?

Dan

 

[dantheram]

I've isolated the problem to when non-consecutive rows are set to be deleted - when the rows follow each other in the table the macro works as desired

 

[Fluff]

Based on your duplicate post I assume you are referring to the code in post#3.
If that's the case it should work regardless of how many rows have Y in column E.
Do the rows with Y in col E get copied to the "completed" sheet? If so have you changed the code in any way?

 

[dantheram]

Based on your duplicate post I assume you are referring to the code in post#3.
If that's the case it should work regardless of how many rows have Y in column E.
Do the rows with Y in col E get copied to the "completed" sheet? If so have you changed the code in any way?

Hi Fluff

yep that's the code.

they are copied over fine, it just if there are non consecutive "Y" entries the code fails - it still copies them over, it just doesn't delete the blanks

"Delete method of Range class failed"

 

[Fluff]

Is your data in a structured table?