CODEWITHSUNDEEP
vbaexcel
BobSki
BobSki

Reputation: 1552

looping through an entire column of values and if value matches, cut and paste it to another sheet

I have columns A, B, C, D, and E with data.

My goal is to start in cell A1, loop through every single record in column A while looking for a particular value "Grey". If the text in cells is equal to "Grey" then i want to cut and paste then entire row to a newly created sheet, starting in A1. here's what my code looks like ....

Dim n As Long
Dim nLastRow As Long
Dim nFirstRow As Long
Dim lastRow As Integer

ActiveSheet.UsedRange

Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
nFirstRow = r.Row

Worksheets("Original").Activate
With Application
.ScreenUpdating = False


Sheets.Add.Name = "NewSheet"

Sheets("Original").Select
Range("A1").Select

Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
nFirstRow = r.Row

With ActiveSheet
    For n = nLastRow To nFirstRow Step -1
        If .Cells(n, "A") = "Grey" Then
            .Cells(n, "A").EntireRow.Cut Sheets("NewSheet").Cells(i, "A")
            .Cells(n, "A").EntireRow.Delete
            n = n + 1
        End If
    Next
End With

.ScreenUpdating = True
End With

So this macro creates a new sheet - however when it gets to a cell where the value is grey it gives me an error on this line....

.Cells(n, "A").EntireRow.Cut Sheets("NewSheet").Cells(i, "A")

Error says:

Application defined or object defined error.

Anyone have any idea why?

Upvotes: 0

Views: 409

Answers (2)

BruceWayne
BruceWayne

Reputation: 23283

You need to declare i, and set it. As mentioned, the first time it occurs it's looking to paste in row 0, which doesn't exist.

Also, it's best to avoid using .Select/.Activate, and work directly with the data.

How does this work?

Sub t()
Dim r As Range
Dim n       As Long, i As Long, nLastRow As Long, nFirstRow As Long
Dim lastRow As Integer
Dim origWS As Worksheet, newWS As Worksheet

Set origWS = Worksheets("Original")
Set newWS = Sheets.Add
newWS.Name = "NewSheet"

Set r = origWS.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
nFirstRow = r.Row

i = 1

With Application
    .ScreenUpdating = False
    With origWS
        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "A") = "Grey" Then
                .Cells(n, "A").EntireRow.Copy newWS.Cells(i, "A")
                .Cells(n, "A").EntireRow.Delete
                i = i + 1
            End If
        Next
    End With
    .ScreenUpdating = True
End With
End Sub

You also don't need to do n = n + 1 (unless I missed something).

Edit: Changed .Cut to .Copy, per OP's wish to keep formatting.

Upvotes: 1

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Or you may try something like this...

Sub CopyToNewSheet()
Dim sws As Worksheet, dws As Worksheet
Application.ScreenUpdating = False
Set sws = Sheets("Original")
On Error Resume Next
Set dws = Sheets("NewSheet")
dws.Cells.Clear
On Error GoTo 0

If dws Is Nothing Then
    Sheets.Add(after:=sws).Name = "NewSheet"
    Set dws = ActiveSheet
End If
sws.Rows(1).Insert
On Error Resume Next
With sws.Range("A1").CurrentRegion
    .AutoFilter field:=1, Criteria1:="Grey"
    .SpecialCells(xlCellTypeVisible).Copy dws.Range("A1")
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
dws.Rows(1).Delete
Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions