CODEWITHSUNDEEP
vbaexcel
Eugene Foo
Eugene Foo

Reputation: 107

VBA Copy rows to a newly created sheet if multiple criteria met

I would like to search a column, "C", and if the first letter of the word does not start with A or M, then I would like to copy the entire row and paste it in a newly created worksheet, with the same formatting. I would also like to copy the remaining rows into another new worksheet.

This is the code that I have used and have referred to several sources but I can't get the desired results. So far, I am only able to create the new worksheets, and copy into the worksheet "Rejected", however it copies everything and the criteria does not seem to work.

Sub sortfunds()

Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Rejected"
Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Accepted"

Dim wRejected As Worksheet
Dim wAccepted As Worksheet
Dim ws As Worksheet
Dim LastRow As Long
Dim i As Long
Dim j As Long
*'j is for 'Accepted' worksheet which I have not worked on yet*

Set ws = ActiveSheet
Set wRejected = ThisWorkbook.Sheets("Rejected")
Set wAccepted = ThisWorkbook.Sheets("Accepted")

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

LastRow = Range("C" & Rows.Count).End(xlUp).Row

With ws
    For i = LastRow To 1 Step -1
        If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M" Then Rows(i).Copy wRejected.Rows(wRejected.Cells(wRejected.Rows.Count, 3).End(xlUp).Row + 1)
    Next i
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Upvotes: 0

Views: 118

Answers (1)

barrowc
barrowc

Reputation: 10679

You are always checking the values in the last row instead of working through each row in turn.

Change:

If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M"

to:

If Left(Range("C" & i), 1) <> "A" And Left(Range("C" & i), 1) <> "M"

Upvotes: 1

Related Questions