Wasn't that difficult, but getting the file back to has been a nightmare (bloody AOL
). In case you don't get it, the E-Mail I sent was as follows: -
The following works for a couple of your requirements, but finding whether an entry is or is not a state is beyond me. The best I can suggest for that is to type in the names/ abbreviations of all the states, define a name for them, click on the column with your state entries and select Data-Validation, choose List and in the source box, put =States. With the column still selected, click on Tools-auditing-Show Toolbar (if necessary) and click on circle invalid data, then copy, paste and delete the rows by hand. You can leave the validation intact so that future entries can't be anything but a state.
The modifications I've made to your original sheet were as follows: -
1. Inserted a new worksheet and typed in the names of the states you want filtered out and named the range of those states MyStates. Also given your data column headings (important).
2. Inserted a command button on sheet1 and named it Extract. Click on this or press Alt-C to run the macro.
3. Opened up the VBA editor and inserted a new module and a new procedure called ExtractStates.
The code transfers filtered data from Sheet1 to Sheet2 based on the criteria in the MyStates range on Sheet4. You'll need to change the code accordingly if you can't fit this in with your current workbook.
Hope it works alright for you, it would have been with you quicker but Aol sucks big time
,
Regards
Chris
The code in the sub is: -
Public Sub ExtractStates()
Application.ScreenUpdating = False
Sheet1.Rows(1).Copy Destination:=Sheet2.Range("A1")
Sheet1.UsedRange.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheet4.Range("MyStates")
On Error Resume Next
Sheet1.UsedRange.CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Sheet2.Range("A65536").End(xlUp).Offset(1, 0)
Sheet1.Cells(1, 1).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
With Sheet1.Range("a1")
.AutoFilter field:=4, Criteria1:="="
.CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Sheet2.Range("A65536").End(xlUp).Offset(1, 0)
.CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Sheet1.AutoFilterMode = False
Sheet2.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub