I have been coding a macro in Excel that scans through a list of records, finds any cells with “CHOFF” in the contents, copying the row that contains it, and pasting those cells into another sheet. It is part of a longer code that formats a report.
It has worked just fine, except that the “For Each” loop has been skipping over some of the entries seemingly at random. It isn’t every other row, and I have tried sorting it differently, but the same cells are skipped regardless, so it doesn’t seem to be about order of cells. I tried using InStr instead of cell.value, but the same cells were still skipped over.
Do you have any idea what could be causing the code just not to recognize some cells scattered within the range?
The code in question is below:
Dim Rng As Range
Dim Cell As Range
Dim x As Integer
Dim y As Integer
ActiveWorkbook.Sheets(1).Select
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
x = 2
For Each Cell In Rng
If Cell.Value = "CHOFF" Then
Cell.EntireRow.Select
Selection.Cut
ActiveWorkbook.Sheets(2).Select
Rows(x).Select
ActiveWorkbook.ActiveSheet.Paste
ActiveWorkbook.Sheets(1).Select
Selection.Delete Shift:=xlUp
y = x
x = y + 1
End If
Next Cell
The For Each...Next
loop doesn’t automatically keep track of which rows you have deleted. When you delete a row, Cell
still points to the same address (which is now the row below the original one, since that was deleted). Then on the next time round the loop, Cell
moves onto the next cell, skipping one.
To fix this, you could move Cell
up one within the If
statement (e.g. with Set Cell = Cell.Offset(-1,0)
). But I think this is one of the rare cases where a simple For
loop is better than For Each
:
Dim lngLastRow As Long
Dim lngSourceRow As Long
Dim lngDestRow As Long
Dim objSourceWS As Worksheet
Dim objDestWS As Worksheet
Set objSourceWS = ActiveWorkbook.Sheets(1)
Set objDestWS = ActiveWorkbook.Sheets(2)
lngLastRow = objSourceWS.Range("C" & objSourceWS.Rows.Count).End(xlUp).Row
lngDestRow = 1
For lngSourceRow = lngLastRow To 1 Step -1
If objSourceWS.Cells(lngSourceRow, 3).Value = "CHOFF" Then
objSourceWS.Rows(lngSourceRow).Copy Destination:=objDestWS.Cells(lngDestRow, 1)
objSourceWS.Rows(lngSourceRow).Delete
lngDestRow = lngDestRow + 1
End If
Next lngSourceRow
This loops backwards (as per Portland Runner’s suggestion) to avoid having to do anything about deleted rows. It also tidies up a couple of other things in your code:
- You don’t need to do any
Select
ing, and it’s better not to (see this question for why) - You can specify a destination within
Range.Copy
rather than having to do a separate select and paste - You can change the value of a variable “in place” without having to assign it to a second variable first (i.e.
x = x + 1
is fine) - you should use
Long
rather thanInteger
for variables that contain row numbers, since there are more rows in an Excel spreadsheet than anInteger
can handle (at least 65536 compared to 32767 max for anInteger
)
Obviously test that it still does what you require!
Answer:
Try using Selection.Copy instead of Selection.Cut
If you have to remove those lines you can mark the lines (for example writing something in an unused cell) inside the loop and then remove it once finished the main loop.
Regards
Answer:
I had a similar issue when I was trying to delete certain rows. The way I overcame it was by iterating through the loop several times using the following:
For c = 1 To 100
Dim d As Long: d = 1
With Sheets("Sheet")
For e = 22 To nLastRow Step 1
If .Range("G" & e) = "" Or .Range("I" & e) = "" Then
.Range("G" & e).EntireRow.Delete
.Range("I" & e).EntireRow.Delete
d = d + 1
End If
Next
End With
c = c + 1
Next
So, basically if you incorporate the outer for loop from my code into your code, it should work.
Tags: excelexcel, oop