ExcelBanter - Removing a Row based on a cell value

The firewall in our company blocked that site - any thing your can cut
and paste?

I copy a part of the site in this thread
******************************

Create a new sheet for one unique value

The example below will copy all rows with the value "Netherlands" in the first column of the range
Sheets("sheet1").Range("A1").CurrentRegion to a new worksheet and give that sheet the name "Netherlands".

Note:
The current region is a range bounded by any combination of blank rows and blank column.
In my example my table start in A1 (header of the first column) and I use this to set
the filter range Range("A1").CurrentRegion (Use Ctrl * with A1 selected to see the filter range)
You can also use another cell then A1 in your table but I like to use the top left cell of the filter range that
is also the header of the first column.

Sub Copy_With_AutoFilter1()
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim Str As String

Set WS = Sheets("sheet1") '<<< Change
'A1 is the top left cell of your filter range and the header of the first column
Set rng = WS.Range("A1").CurrentRegion '<<< Change
Str = "Netherlands" '<<< Change

'Close AutoFilter first
WS.AutoFilterMode = False

'This example filter on the first column in the range (change the field if needed)
rng.AutoFilter Field:=1, Criteria1:=Str

Set WSNew = Worksheets.Add
WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
WS.AutoFilterMode = False

On Error Resume Next
WSNew.Name = Str
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
End Sub

Note :
You can delete the Sheets("Netherlands") first if you want to copy the data again.
This way the sheet is always up to date after you run the sub.

Copy this code after the Dim lines.

On Error Resume Next
Application.DisplayAlerts = False
Sheets("Netherlands").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Manual

Activate AutoFilter:
Select a cell in your data table and use DataFilterAutoFilter to activate AutoFilter.
Tip: Shortcut for the English version is Alt d f f

In each header cell a dropdown will appear next to your field name.
Click on the dropdown in the Country field and choose Netherlands.

Copy the filter result
1) Be sure that the active cell is in the data range
2) Press Ctrl * to select all data or use F5SpecialCurrent regionOK
3) Press Alt ; to select all visible data or use F5SpecialVisible cells onlyOK
4) Ctrl c or EditCopy
5) InsertWorksheet
6) Ctrl v or EditPaste
7) Select the sheet with the filter ( Sheet("Netherlands") in my example )
8) Press Esc
9) Press Alt d f f or DataFilterAutoFilter to turn off AutoFilter

Add data to a existing sheet

The example below will copy all rows with the value "Netherlands" in the first column of the range
Sheets("sheet1").Range("A1").CurrentRegion to the first empty row on the worksheet "Netherlands".
This example will also delete the records with "Netherlands" after it copy them to the Sheets("Netherlands")

Note:
The current region is a range bounded by any combination of blank rows and blank column.
In my example my table start in A1 (header of the first column) and I use this to set
the filter range Range("A1").CurrentRegion (Use Ctrl * with A1 selected to see the filter range)
You can also use another cell then A1 in your table but I like to use the top left cell of the filter range that
is also the header of the first column.

Sub Copy_With_AutoFilter_2()
' This sub use the function LastRow
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim Str As String

Set WS1 = Sheets("sheet1") '<<< Change
Set WS2 = Sheets("Netherlands") '<<< Change
'A1 is the top left cell of your filter range and the header of the first column
Set rng1 = WS1.Range("A1").CurrentRegion '<<< Change
Str = "Netherlands" '<<< Change

'Close AutoFilter first
WS1.AutoFilterMode = False

'This example filter on the first column in the range (change the field if needed)
rng1.AutoFilter Field:=1, Criteria1:=Str

With WS1.AutoFilter.Range
On Error Resume Next
' This example will not copy the header row
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
'Copy the cells
rng2.Copy WS2.Range("A" & LastRow(WS2) + 1)
'Delete the rows in WS1
rng2.EntireRow.Delete
End If
End With
WS1.AutoFilterMode = False
End Sub

Don't forget to copy this function in the module.

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl

"harpscardiff" wrote in message
news:harpscardiff.22yzzn_1139502305.4718@excelforu m-nospam.com...

The firewall in our company blocked that site - any thing your can cut
and paste?

cheers.

--
harpscardiff
------------------------------------------------------------------------
harpscardiff's Profile: http://www.excelforum.com/member.php...o&userid=25960
View this thread: http://www.excelforum.com/showthread...hreadid=510577