Excel Jululian

[George A. Jululian]

Hi all,

I have worksheet full of data and I need your help

I Need a macro (VBA) to sort them all and to remove the entire rows for
Apple, Banana and put them in sheet separate


Apple 5 6 7 8
Banana 4 3 5 87
Appel 5 6 7 8
Appel 5 6 7 8
Banana 4 3 5 87
Appel 5 6 7 8
Appel 5 6 7 8
Orange 11 3 55 2
Appel 5 6 7 8
Appel 5 6 7 8
Orange 11 3 55 2

Please help

 

[Mike H]

Hi,

Right click the sheet tab of the sheet that contains this data, view code
and paste this in. It will copy the data to sheet 2 and sheet 3

Sub stance()
Dim MyRange As Range, AppleRange As Range, OrangeRange As Range
Dim BuildRange As Range
Lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & Lastrow)
For Each c In MyRange
Select Case UCase(c.Value)
Case Is = "APPLE"
If AppleRange Is Nothing Then
Set AppleRange = c.EntireRow
Else
Set AppleRange = Union(AppleRange, c.EntireRow)
End If
Case Is = "ORANGE"
If OrangeRange Is Nothing Then
Set OrangeRange = c.EntireRow
Else
Set OrangeRange = Union(OrangeRange, c.EntireRow)
End If
Case Else
End Select
Next

If Not AppleRange Is Nothing Then
AppleRange.Copy Destination:=Sheets("Sheet2").Range("A1")
End If

If Not OrangeRange Is Nothing Then
OrangeRange.Copy Destination:=Sheets("Sheet3").Range("A1")
End If
End Sub

Mike



Mike

 

[George A. Jululian]

Sorry it does not

Hi,

Right click the sheet tab of the sheet that contains this data, view code
and paste this in. It will copy the data to sheet 2 and sheet 3

Sub stance()
Dim MyRange As Range, AppleRange As Range, OrangeRange As Range
Dim BuildRange As Range
Lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & Lastrow)
For Each c In MyRange
Select Case UCase(c.Value)
Case Is = "APPLE"
If AppleRange Is Nothing Then
Set AppleRange = c.EntireRow
Else
Set AppleRange = Union(AppleRange, c.EntireRow)
End If
Case Is = "ORANGE"
If OrangeRange Is Nothing Then
Set OrangeRange = c.EntireRow
Else
Set OrangeRange = Union(OrangeRange, c.EntireRow)
End If
Case Else
End Select
Next

If Not AppleRange Is Nothing Then
AppleRange.Copy Destination:=Sheets("Sheet2").Range("A1")
End If

If Not OrangeRange Is Nothing Then
OrangeRange.Copy Destination:=Sheets("Sheet3").Range("A1")
End If
End Sub

Mike



Mike

 

[muddan madhu]

create a header row for your data

and then run the macro

Sub separate()
Range("A1").Select
Selection.AutoFilter field:=1, Criteria1:="apple"
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets.Add.Name = "apple"
ActiveSheet.Paste
ActiveSheet.Next.Select
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="banana"
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets.Add.Name = "banana"
ActiveSheet.Paste
ActiveSheet.Next.Select
ActiveSheet.ShowAllData
Application.CutCopyMode = False
End Sub

 

[George A. Jululian]

Many Thanks it works

but how can i amend the VBA to do more then two filters

George

 

[JLatham]

Just keep 'repeating' one of the copying sections of the code, as:

Selection.AutoFilter field:=1, Criteria1:="banana"
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets.Add.Name = "banana"
ActiveSheet.Paste
ActiveSheet.Next.Select
ActiveSheet.ShowAllData

and insert it just before the Application.CutCopyMode= False statement.
Change "banana" to whatever you need the new criteria to be.

 

[George A. Jululian]

Many thanks its works

But I counted the apple in the data there where 15 row and its only filtered
12

Is there way to extend the range to read from a1:A5000

Thanks for your help

 

[George A. Jululian]

many thanks it works very good

please can i amend instead of A1 to D1 and do the same


Many thanks

 

[JLatham]

I suspect that there are one of 2 situations that are messing things up:
1st possibility, the more likely of the two is that there is a blank cell
somewhere between A1 and the end of the data in the column, or
2nd possibility - that "apple" isn't always spelled as "apple" - it may be
"apple " or " apple" in those 3 instances.

One way to check # 2 would be to click in A1 and use Data | AutoFilter and
see if there appear to be 2 entries for apple in the list you get to choose
from. Actually this will check #1 also - as you'll see apples only for 12
rows then you'd see an empty cell and the rest of the list (unfiltered) below
that.

Just extending the range to 5000 wouldn't help if the blank cell is the
problem - you'd end up copying extra entries to the new sheet anyhow.

 

[George A. Jululian]

Hi,

Many thanks for your help

please advice can i refer to cell in sheet2 instead of typying "Apple"

Selection.AutoFilter field:=1, Criteria1:="Apple"

Regards