[RESOLVED] Compare rows and copy to new sheet (VBA)

[Radjesh Klauke]

Hi, me again :P

If Value in Column A > then Column B then copy the row to a new sheet (for example sheet2). Any chance someone knows how to code it in VBA or willing to give me a kickstart?
The sheet isn't always the same and contains 100's or rows, that's why I want to automate it. Had enough of it :P


Thanks in advance.

[4x2y]

Hi, me again :P

Try this kickoff

Sub FilterRows()

  Dim cDestination As Worksheet
  Dim cSource As Worksheet
  Dim intRow As Integer
  
  Set cSource = Worksheets("Sheet1") ' Replace "Sheet1" with actual name.
  Set cDestination = CreateNewSheet
  
  For j = 1 To cSource.UsedRange.Rows.Count
    If Cells(j, 1) <> vbNullString And Cells(j, 2) <> vbNullString Then
      If Val(Cells(j, 1)) > Val(Cells(j, 2)) Then
        Cells(j, 1).EntireRow.Copy
        intRow = intRow + 1
        cDestination.Cells(intRow, 1).PasteSpecial Paste:=xlPasteValues
      End If
    End If
  Next
  
End Sub

Private Function CreateNewSheet() As Worksheet
    Dim ret As Worksheet
    On Error GoTo CreateSheet
    Set ret = Worksheets("destination") ' Replace "destination" with desired name.
    Set CreateNewSheet = ret
    
    Exit Function
CreateSheet:
      Set ret = Worksheets.Add(After:=Worksheets(Worksheets.Count))
      ret.Name = "destination"
      Set CreateNewSheet = ret

End Function

Any rep+ is appriciated

[Radjesh Klauke]

Don't worry about the +REP m8. I'm generous. Will try it tomorrow and let you know

[Radjesh Klauke]

Creating the sheet gave me an "index out of range" error during the creation of the new sheet in my official workbook. Tried to solve it for a long time. Someone helped me and we got the following code working:

    With Sheets("IK_WRONGT")
        .Range("A1").PasteSpecial
        For rw = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
            If Cells(rw, "AE").Value > Cells(rw, "AF").Value Then Rows(rw).Copy .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row)
        Next
    End With

+REP for all the troubles and help m8. Much appreciated.

[Pradeep1210]

Try this:

Sub CopySpecial()
    Dim SourceSheet As Worksheet, DestinationSheet As Worksheet
    Dim LastRow As Long, R As Long, R1 As Long
 
    '' change this as required
    Set SourceSheet = ActiveWorkbook.Sheets("Sheet1")
    Set DestinationSheet = ActiveWorkbook.Sheets("Sheet2")
    
    LastRow = SourceSheet.Range("A1").SpecialCells(xlLastCell).Row
    For R = 1 To LastRow
        If SourceSheet.Range("A" & R) > SourceSheet.Range("B" & R) Then
            R1 = R1 + 1
            SourceSheet.Range(R & ":" & R).Copy DestinationSheet.Range("A" & R1)
        End If
    Next
End Sub

[jmcco002]

Your code is EXACTLY what I needed for a macro I am creating at work. However, how would I change the SourceSheet to the active workbook and active worksheet, which will not always be named sheet1? Also, how do I change the DestinationSheet to a different workbook?

Thanks for writing the above code.

[Pradeep1210]

Your code is EXACTLY what I needed for a macro I am creating at work. However, how would I change the SourceSheet to the active workbook and active worksheet, which will not always be named sheet1? Also, how do I change the DestinationSheet to a different workbook?

Thanks for writing the above code.

You can use ActiveWorkbook.ActiveSheet in that case.

Set SourceSheet = ActiveWorkbook.ActiveSheet

Same way you can change the DestinationSheet to some other sheet. You will need to know either the sheet name, or the ordinal position etc.

Here are various ways to reference any worksheet/worksheet:

ActiveWorkBook --> The workbook that is active.
ThisWorkBook --> The workbook in which this macro is running from.
ActiveSheet --> The active sheet
Sheets("SheetName") --> The sheet "SheetName". e.g. Sheets("Sheet1"), Sheets("Sheet2")
Sheets(SheetNumber) --> The sheet at the position specified by SheetNumber. e.g. Sheets(1), Sheets(2)

If you don't prefix WorkBook before WorkSheet, then the ActiveWorkBook is assumed.