ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Excel Jululian (https://www.excelbanter.com/excel-discussion-misc-queries/219036-excel-jululian.html)

George A. Jululian[_2_]

Excel 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

Excel Jululian
 
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" wrote:

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


George A. Jululian[_2_]

Excel Jululian
 
Sorry it does not



"Mike H" wrote:

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" wrote:

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


muddan madhu

Excel Jululian
 

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

On Feb 4, 3:54*pm, George A. Jululian
wrote:
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 * * * * * * * * * * * * * *



George A. Jululian[_2_]

Excel Jululian
 
Many Thanks it works

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

George

"muddan madhu" wrote:


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

On Feb 4, 3:54 pm, George A. Jululian
wrote:
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




JLatham

Excel Jululian
 
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" wrote:

Many Thanks it works

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

George

"muddan madhu" wrote:


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

On Feb 4, 3:54 pm, George A. Jululian
wrote:
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




George A. Jululian[_2_]

Excel 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

"JLatham" wrote:

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" wrote:

Many Thanks it works

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

George

"muddan madhu" wrote:


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

On Feb 4, 3:54 pm, George A. Jululian
wrote:
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



George A. Jululian[_2_]

Excel Jululian
 
many thanks it works very good

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


Many thanks


"Mike H" wrote:

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" wrote:

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


JLatham

Excel Jululian
 
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" wrote:

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

"JLatham" wrote:

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" wrote:

Many Thanks it works

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

George

"muddan madhu" wrote:


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

On Feb 4, 3:54 pm, George A. Jululian
wrote:
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



George A. Jululian[_2_]

Excel 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

"JLatham" wrote:

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" wrote:

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

"JLatham" wrote:

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" wrote:

Many Thanks it works

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

George

"muddan madhu" wrote:


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

On Feb 4, 3:54 pm, George A. Jululian
wrote:
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




All times are GMT +1. The time now is 09:56 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com