Cut and Paste Data from One sheet to another

[jfoBoston]

I'm timing out when running the following (pressing escape debugs on the RED below):

'moving data from "Solicitation File" if the value in Column V is null - it is copying to the new worksheet, but never completes - stalls at "If CStr(xRg(K).Value) = "" Then" - data is getting to the new sheet, but the module hangs.

Sub MoveNoPhone()


With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "No Phone"

End With




Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Solicitation File").UsedRange.Rows.Count
J = Worksheets("No Phone").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("No Phone").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Solicitation File").Range("V2:V" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("No Phone").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "" Then
K = K - 1
End If
J = J + 1
End If
Next

Cells.Select
Columns.EntireColumn.AutoFit
Cells.EntireRow.AutoFit

Application.ScreenUpdating = True


End Sub

 

[NdNoviceHlp]

Maybe...

For K = 1 To xRg.Row.Count
If CStr(xRg.Rows(K)) = "" Then
 xRg.Row(K).EntireRow.Copy Destination:=Worksheets("No Phone").Range("A" & J + 1)
 xRg.Row(K).EntireRow.Delete
 If CStr(xRg.Rows(K)) = "" Then

HTH. Dave
ps. Welcome to the Board! Please use code tags

 

[jfoBoston]

Thanks Dave! I appreciate the quick response and the welcome.

I swapped out the code you edited, and it stalls on the line above the last one. I'll keep tinkering.

 

[NdNoviceHlp]

Not clear on which line you're having trouble? Dave

 

[Fluff]

The code is not hanging, it's just that you have written a permanent loop.
When deleting or inserting rows, you should always work from bottom up. Try

Sub MoveNoPhone()


With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet5"

End With




Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Active").UsedRange.Rows.Count
J = Worksheets("sheet2").UsedRange.Rows.Count
If J = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Active").Range("V2:V" & i)
Application.ScreenUpdating = False
For K = xRg.Count To 1 Step -1
   If CStr(xRg(K).Value) = "" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      J = J + 1
   End If
Next

Cells.Select
Columns.EntireColumn.AutoFit
Cells.EntireRow.AutoFit

Application.ScreenUpdating = True


End Sub