Macro to compare row criteria and cut to tab

**somesoldiers** · 06-24-2010, 04:18 AM

Hi guys

Am working on a macro which needs to do the below
Data is sorted by A. Where 1 row matches the row below on Columns A, C, ABS D, H, I and J both rows should be copied to Boxes tab. Where there is only a single a/c number or both rows don't match on any 1 of the criteria- rows should remain on the Data tab.

Appreciate any help

Thanks

Noel

**pierre08** · 06-24-2010, 04:39 AM

Hi,
try this:

Sub t()
Dim i As Double


For i = 1 To Range("A1").End(xlDown).Row
Sheets("Data").Activate
    If Range("A1").Offset(i, 0) = Range("A1").Offset(i + 1, 0) _
        And Range("C1").Offset(i, 0) = Range("C1").Offset(i + 1, 0) _
        And Range("D1").Offset(i, 0) = Range("D1").Offset(i + 1, 0) _
        And Range("H1").Offset(i, 0) = Range("H1").Offset(i + 1, 0) _
        And Range("I1").Offset(i, 0) = Range("I1").Offset(i + 1, 0) _
        And Range("J1").Offset(i, 0) = Range("J1").Offset(i + 1, 0) Then
        
    Range("A1").Offset(i, 0).EntireRow.Copy
    
    Sheets("Boxes").Activate
    Range("A1").Activate
    Do While ActiveCell.Value <> ""
        ActiveCell.Offset(1, 0).Activate
    Loop
    ActiveSheet.Paste
    
    Application.CutCopyMode = False
    End If
Next i


End Sub

Hope it helps

**somesoldiers** · 06-24-2010, 05:12 AM

ok almost there, I have amended slightly to a/c for the ABS value of D- this seems to have worked. I just need to amend slightly so that both matching rows will be copied not just one, can you advise, thanks

Sub t()
Dim i As Double


For i = 1 To Range("A1").End(xlDown).Row
Sheets("Data").Activate
    If Range("A1").Offset(i, 0) = Range("A1").Offset(i + 1, 0) _
        And Range("C1").Offset(i, 0) = Range("C1").Offset(i + 1, 0) _
        And Abs(Range("D1").Offset(i, 0)) = Abs(Range("D1").Offset(i + 1, 0)) _
        And Range("H1").Offset(i, 0) = Range("H1").Offset(i + 1, 0) _
        And Range("I1").Offset(i, 0) = Range("I1").Offset(i + 1, 0) _
        And Range("J1").Offset(i, 0) = Range("J1").Offset(i + 1, 0) Then
        
    Range("A1").Offset(i, 0).EntireRow.Copy
    
    Sheets("Boxes").Activate
    Range("A1").Activate
    Do While ActiveCell.Value <> ""
        ActiveCell.Offset(1, 0).Activate
    Loop
    ActiveSheet.Paste
    
    Application.CutCopyMode = False
    End If
Next i


End Sub

**somesoldiers** · 06-24-2010, 04:51 AM

Thanks Piere

am getting a syntax error for below line?

For i = 1 To Range("A1").End(xlDown).Row Sheets("Data").Activate

Thanks

Noel

Edit: my fault was th way I was copying it, let me test and let you, know, thanks again

**pierre08** · 06-24-2010, 05:17 AM

Just put this :

Range(Range("A1").Offset(i, 0), Range("A1").Offset(i+1, 0)).EntireRow.Copy

in steed of:

   Range("A1").Offset(i, 0).EntireRow.Copy

**somesoldiers** · 06-24-2010, 05:24 AM

looks good now, thanks a lot for your help Pierre

Macro to compare row criteria and cut to tab

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro to compare row criteria and cut to tab

Re: Macro to compare row criteria and cut to tab

Re: Macro to compare row criteria and cut to tab

Re: Macro to compare row criteria and cut to tab

Re: Macro to compare row criteria and cut to tab

Re: Macro to compare row criteria and cut to tab

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions