Copying rows onto new sheet

[ArsenalFan1]

Hi,

I have a sheet called "Companies"

Information is stored as follows:

LOCATION-----COMPANY------AMOUNT
Edmonton------XYZ------------12
Edmonton------YZ--------------10
Toronto---------XYZ------------13
Toronto---------FAS------------12
Toronto---------EES------------15
Calgary---------EES------------12
Calgary---------XYZ------------13

I want to use VB to do the following:
Copy all rows with Edmonton followed by Calgary into a new sheet (to create itself) called "Alberta"
Copy all rows with Toronto into a sheet called "Ontario"

All your help is very much appreciated.

 

[ArsenalFan1]

Oh yeah this button i will have will not be located in the sheet called "Companies" but in another sheet called "Main". Button meaning that i will press the button and it will seperate the sheet itself.

Thanks again.

 

[Norie]

Is there a column in the data for the provinces?

 

[ArsenalFan1]

no we have to search for all rows containing edmonton (which is row 1) and put them in a new sheet called Alberta

then we will search all rows containing calgary and put them in Alberta sheet

Then we will search all rows containing toronto and put them in a new sheet called Ontario.

These are the only 3 cities and only 2 sheets need to be created.

 

[Norie]

That's a shame, would have been easier if the provinces were there.

Anyway, try this which assumes the data is in columns A-C starting in row 1.

Sub DistributeRows()
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
    
    Set wsData = Worksheets("Sheet1")
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wsCrit = Worksheets.Add
    wsCrit.Range("A1") = "LOCATION"
    
    Set wsNew = Worksheets.Add
    wsNew.Name = "Ontario"
        
    wsCrit.Range("A2") = "Toronto"
    wsData.Range("A1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), CopyToRange:=wsNew.Range("A1")
    
    Set wsNew = Worksheets.Add
    wsNew.Name = "Alberta"

    wsCrit.Range("A2") = "Edmonton"
    wsCrit.Range("A3") = "Calgary"
    wsData.Range("A1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A3"), CopyToRange:=wsNew.Range("A1")

    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub