deleting and moving rows to another sheet

[Mr Marvin]

i use the macro below to move rows on to a pending worksheet from the data sheet. issue i have is that when they are deleted and moved over into pending sheet i would want the rows to start at A2. but they seem to just get moved to randoms rows e.g. A412. can any one help on why this would be happening.

Sub Cheezy()

Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Data").UsedRange.Rows.Count
J = Worksheets("Pending").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Pending").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Data").Range("I1:I" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Pending-Further Info Required" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Pending").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Pending-Further Info Required" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[HaHoBe]

Hi Mr Marvin,

do you really want to overwrite the data in sheets Pending? If so change the codelines

J = Worksheets("Pending").UsedRange.Rows.Count

If J = 1 Then
  If Application.WorksheetFunction.CountA(Worksheets("Pending").UsedRange) = 0 Then J = 0
End If

to

J = 2

The following code will put the moved data under any data in sheet Pending:

Sub MrE1216298()
'https://www.mrexcel.com/board/threads/deleting-and-moving-rows-to-another-sheet.1216298/

Dim rngPending As Range
Dim lngCounter As Long
Dim rngDelete As Range

With Worksheets("Data")
  Set rngPending = .Range("I1:I" & .UsedRange.Rows.Count)
End With
'On Error Resume Next
Application.ScreenUpdating = False
For lngCounter = 1 To rngPending.Count
  If CStr(rngPending(lngCounter).Value) = "Pending-Further Info Required" Then
    rngPending(lngCounter).EntireRow.Copy Destination:=Worksheets("Pending").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If rngDelete Is Nothing Then
      Set rngDelete = rngPending(lngCounter)
    Else
      Set rngDelete = Union(rngDelete, rngPending(lngCounter))
    End If
  End If
Next lngCounter

If Not rngDelete Is Nothing Then
  rngDelete.EntireRow.Delete
End If

Set rngDelete = Nothing
Set rngPending = Nothing

Application.ScreenUpdating = True
End Sub

Here a range is set to delete at the end of the code instead of deleting each single row and manipulate the loop counter.

HTH
Holger

 

[HaHoBe]

Hi,

code works like above but when having built a range object you could use that for a For Each...- loop like

Sub MrE1216298_2()
'https://www.mrexcel.com/board/threads/deleting-and-moving-rows-to-another-sheet.1216298/

Dim rngPending As Range
Dim rngDelete As Range
Dim rngCell As Range

With Worksheets("Data")
  Set rngPending = .Range("I1", .Cells(.Rows.Count, "I").End(xlUp))
End With
'On Error Resume Next
Application.ScreenUpdating = False
For Each rngCell In rngPending
  If rngCell.Value = "Pending-Further Info Required" Then
    rngCell.EntireRow.Copy Destination:=Worksheets("Pending").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If rngDelete Is Nothing Then
      Set rngDelete = rngCell
    Else
      Set rngDelete = Union(rngDelete, rngCell)
    End If
  End If
Next rngCell

If Not rngDelete Is Nothing Then
  rngDelete.EntireRow.Delete
End If

Set rngDelete = Nothing
Set rngPending = Nothing

Application.ScreenUpdating = True
End Sub

Ciao,
Holger