# Thread: Code To Remove Only 2 Rows Thanks: 0 Likes: 0

1. ## Code To Remove Only 2 Rows

I have a sheet as below. Whenever there are 2 rows only that match in K then I want them removed to another sheet. This must be when there is one heater blower and one heater in column AF. So in this example below rows 2-4 and 5-7 will remain as there are 3 rows but the rest would be removed to another sheet as there are only 2 rows and there is one description for each.

Excel 2010#DAE7F5 " />#DAE7F5 ;text-align: center;color: #161120">
2M14301280143001Heater Blower
3M14301280143001Heater
4M14301280143001Heater
5M14301280143003Heater Blower
6M14301280143003Heater
7M14301280143003Heater
8M14301280145007Heater Blower
9M14301280145007Heater
10M14301280145011Heater Blower
11M14301280145011Heater
12M14301280145008Heater Blower
13M14301280145008Heater
14M14301280145002Heater Blower
15M14301280145002Heater
16M14301280145005Heater Blower
17M14301280145005Heater

#DAE7F5 ;color: #161120">Sheet1

2. ## Re: Code To Remove Only 2 Rows

I hope I explained this ok, please post should you need clarification.

3. ## Re: Code To Remove Only 2 Rows

Can anyone help with this please?

4. ## Re: Code To Remove Only 2 Rows

Is this a complicated code I am needing?

5. ## Re: Code To Remove Only 2 Rows

Here is one way to do it:

Enter this formula in cell AI2 and copy down for all rows:
Code:
`=AND(COUNTIF(K:K,K2)=2,COUNTIFS(K:K,K2,AF:AF,"Heater Blower")=1,COUNTIFS(K:K,K2,AF:AF,"Heater")=1)`
This should identify every row that needs to be moved by returning "TRUE".
You can then use Advanced Filters to copy them to another sheet, and then delete the TRUE entries from the original sheet.

6. ## Re: Code To Remove Only 2 Rows

Here is the VBA code that I came up with to do this:
Code:
```Sub MyMoveMacro()

Dim lr As Long
Dim sh1 As Worksheet, sh2 As Worksheet

Application.ScreenUpdating = False

'   Set worksheet data resides on
Set sh1 = Sheets("Sheet1")
'   Set worksheet to copy data to
Set sh2 = Sheets("Sheet2")

'   Find last row with data in column K
lr = sh1.Cells(Rows.Count, "K").End(xlUp).Row

'   Populate formula in column AI
sh1.Range("AI1") = "Move"
sh1.Range("AI2:AI" & lr).FormulaR1C1 = _
"=AND(COUNTIF(C[-24],RC[-24])=2,COUNTIFS(C[-24],RC[-24],C[-3],""Heater Blower"")=1,COUNTIFS(C[-24],RC[-24],C[-3],""Heater"")=1)"

'   Filter TRUE entries to new sheet
sh2.Activate
sh2.Range("AK1") = "Move"
sh2.Range("AK2") = "TRUE"
CriteriaRange:=Range("AK1:AK2"), CopyToRange:=Range("K1"), Unique:=False
sh2.Columns("AI:AK").ClearContents
sh2.Cells.EntireColumn.AutoFit

'   Delete TRUE entries from original sheet
sh1.Activate
sh1.Range("\$K\$1:\$AI\$" & lr).AutoFilter Field:=25, Criteria1:="TRUE"
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
sh1.AutoFilterMode = False
sh1.Columns("AI:AI").ClearContents

Application.ScreenUpdating = True

End Sub```
Note that you will need to update the value of the "sh1" and "sh2" variables to reflect the names of the sheet that you are working with.
I am also assuming that your data is in columns K:AH. If we need to extend it out to include other columns, the code may need to be altered.

7. ## Re: Code To Remove Only 2 Rows

Sorry the data starts in A to AV. I thought I would just include the important data to make it clearer.

8. ## Re: Code To Remove Only 2 Rows

Yes, it is important to mention that, since you want to move those cells too.

Try this variation:
Code:
```Sub MyMoveMacro()

Dim lr As Long
Dim sh1 As Worksheet, sh2 As Worksheet

Application.ScreenUpdating = False

'   Set worksheet data resides on
Set sh1 = Sheets("Sheet1")
'   Set worksheet to copy data to
Set sh2 = Sheets("Sheet2")

'   Find last row with data in column K
lr = sh1.Cells(Rows.Count, "K").End(xlUp).Row

'   Populate formula in column AW
sh1.Range("AW1") = "Move"
sh1.Range("AW2:AW" & lr).FormulaR1C1 = _
"=AND(COUNTIF(C[-38],RC[-38])=2,COUNTIFS(C[-38],RC[-38],C[-17],""Heater Blower"")=1,COUNTIFS(C[-38],RC[-38],C[-17],""Heater"")=1)"

'   Filter TRUE entries to new sheet
sh2.Activate
sh2.Range("AX1") = "Move"
sh2.Range("AX2") = "TRUE"
CriteriaRange:=Range("AX1:AX2"), CopyToRange:=Range("A1"), Unique:=False
sh2.Columns("AW:AX").ClearContents
sh2.Cells.EntireColumn.AutoFit

'   Delete TRUE entries from original sheet
sh1.Activate
sh1.Range("\$A\$1:\$AW\$" & lr).AutoFilter Field:=49, Criteria1:="TRUE"
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
sh1.AutoFilterMode = False
sh1.Columns("AW:AW").ClearContents

Application.ScreenUpdating = True

End Sub```

9. ## Re: Code To Remove Only 2 Rows

Thanks Joe I run the code and it completed but nothing moved to sheet 2? It looks like it removed them but didn't paste them onto sheet 2.

10. ## Re: Code To Remove Only 2 Rows

Don't worry I used the formula and that done the job. Thanks.