SEARCH AND DELETE

[Guest]

Here is my problem. I export data every morning and have this done manually.
I am hoping that there may be a macro to do it for me.

Here is an example of the data before I make changes.

Column A Column B

0006-310-1 M40C
0006-310-1 M40C
0006-310-1 S210
0006-310-1 M54E
2003-999-6 Q43A
2003-999-6 E46A
2003-999-6 S111
0111-999-2 F20A
0111-999-2 J01C

Here is the data after I made changes

Column A Column B

0111-999-2 F20A

------------------------------------------------------------------------------------------------
What I need it to do is search column A and B group like model numbers
together that are in column A and then search column B to see if any one of
them exist in a S* (I am using * as a wild card) location. If it does exist
in S* then delete all those rows. If the model number group does not exist
in a S* location then delete all but one row leaving the model number and a
location to get it from.

This may seem easier said than done, I normally deal with any where from 200
rows to 50,000 rows, and roughly 500-1000 model numbers.

I hope I explained this correctly, if not then hopefully the diagrams help.
Any assistance would be great.

Thanks,

Sean

 

[Guest]

It is unclear what you are trying to match and what you are trying to do. If
you want sample code, give a specific example with exact locations and a
sample of finding a match.

 

[Bernie Deitrick]

Sean,

Try the macro below. Assumes that on;ly columns A and B are filled.

HTH,
Bernie
MS Excel MVP

Sub MacroForSean()
Dim myR As Range
Dim myCell As Range
Dim i As Long
Dim uRow As Long
Dim myVal() As Variant

Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("E1"), _
Unique:=True

uRow = Range("E65536").End(xlUp).Row

ReDim myVal(2 To uRow)
For i = 2 To uRow
myVal(i) = Range("E" & i).Value
Next i

For i = 2 To uRow
Set myR = Range("B2", Range("B65536").End(xlUp))
Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=myVal(i)
Set myCell = myR.SpecialCells(xlCellTypeVisible).Find("S*")
If Not myCell Is Nothing Then
myR.Offset(0, -1).Resize(, 2).Delete shift:=xlUp
Else
myR.Offset(0, -1).Resize(myR.Rows.Count - 1, 2).Delete shift:=xlUp
End If
ActiveSheet.ShowAllData
Next i

Range("A1").CurrentRegion.AutoFilter
Range("E:E").Delete
Range("A1").Select
End Sub

 

[Guest]

It "DEBUGED" AT "ACTIVE.SHEET.SHOWALLDATA". Other than that it seemed to be
moving along fine. Any help???

 

[Guest]

It "DEBUGED" AT "ACTIVE.SHEET.SHOWALLDATA". Other than that it seemed to be
moving along fine. Any help???

 

[Guest]

Bernie


It "DEBUGED" AT "ACTIVE.SHEET.SHOWALLDATA". Other than that it seemed to be
moving along fine. Any help???

 

[Guest]

It "DEBUGED" AT "ACTIVE.SHEET.SHOWALLDATA". Other than that it seemed to be
moving along fine. Any help???

 

[Guest]

Bernie


It "DEBUGED" AT "ACTIVE.SHEET.SHOWALLDATA". Other than that it seemed to be
moving along fine. Any help???

 

[Guest]

Bernie.

It debugged at "application show all data, any idea?

 

[Bernie Deitrick]

Sean,

It worked fine for me. Are you running it from a commandbutton or through
Tools / Macro....?

Bernie

 

[Guest]

Bernie,

I am running it from "tools and macros", the error it reads is

Run-time error '1004':

ShowAllData method of Worksheet class failed.

Any ideas Again, Sorry...

 

[Bernie Deitrick]

Sean,

That error means that your data set is empty when the macro finishes running - you don't have any
set of model number data points that lacks a location with an S.

Try the macro on the small set of data that you originally posted, to see the result when your data
is as expected.


To handle the error, put this line at the top of your code:

On Error Resume Next


HTH,
Bernie
MS Excel MVP

 

[Guest]

I would recommend putting it just before the line that might cause the error
and immediately after that line putting in

On Error Resume next
ActiveSheet.ShowAllData
On Error goto 0

Just throwing it in at the top could mask other errors which should not be
ignored.