Filter problem continued 2

[willyboy58]

In a previous post, I did not do a very good job of explaining my situation or including good data. Below is some data on a worksheet (“propnova”) that needs to be filtered. This is a very abbreviated table of info. My actual table has over 200 records to filter.

Branch Fund Number Name
1 1 1500 LuLu
1 1 1510 Pheobe
1 1 1520 John
2 1 1600 Rita
2 1 1620 Connie
2 1 1650 Paul
3 1 1000 Bob
3 1 1111 Steve
3 1 1200 Dennis
3 4 2000 Jason
3 4 2222 Mark
3 4 2333 Curtis

From the above table, I need four new worksheets with the names: Branch 1, Branch 2, Branch 3 and NOVA. Worksheets for Branch 1, 2 and 3 will have employees with the Fund code “1” and Worksheet NOVA will have employees with the Fund code “4”. Please note that branch 3 from the table has employees with both Fund 1 and Fund 4. The Fund 4 people are the NOVA people that need their own worksheet too. The following code separates the 3 branches, but not the NOVA people to their own worksheet. Please note that the following code is used with other procedures to manipulate a lot of data.

Sub SeparateBranchesAndNova()
Application.ScreenUpdating = False
Dim curVal As Long, lRow As Long, origSht As Worksheet
Windows("propnova.xls&quot.Activate
Range("A1&quot.Select
Selection.EntireRow.Insert
Activecell.FormulaR1C1 = "Branch"
Range("B1&quot.Select
Activecell.FormulaR1C1 = "Fund"
Range("C1&quot.Select
Activecell.FormulaR1C1 = "Number"
Range("D1&quot.Select
Activecell.FormulaR1C1 = "Name"
Range("E1&quot.Select
Activecell.FormulaR1C1 = "Date"
Range("F1&quot.Select
Activecell.FormulaR1C1 = "Job"
Range("G1&quot.Select
Activecell.FormulaR1C1 = "Hours"
Set origSht = ActiveSheet
lRow = Range("A65536&quot.End(xlUp).Row

For I = 2 To lRow 'assumes you put headers in and data starts at row 2
With origSht
If .Range(&quot;A&quot; & I).Value <> .Range(&quot;A&quot; & I - 1).Value Then
curVal = .Range(&quot;A&quot; & I).Value
.Range(&quot;A1:F&quot; & lRow).AutoFilter Field:=1, Criteria1:=curVal
.Range(&quot;A1:F&quot; & lRow).Copy

Worksheets.Add
ActiveSheet.Name = &quot;Branch &quot; & curVal
Range(&quot;A1&quot.Select
Selection.PasteSpecial
Range(&quot;A1&quot.Select
Selection.EntireColumn.Delete ‘removes the fund number col
Columns(&quot;A:F&quot.EntireColumn.AutoFit
Range(&quot;A1&quot.Select
Else
End If
End With
Next I
Application.ScreenUpdating = True
End Sub

How do I get the NOVA people separated from the Branch 3 people and end up with the 4 worksheets: Branch 1, Branch 2, Branch 3 and NOVA?

As always, TIA.

Bill

 

[DaleWatson123321]

Hi Bill,

Having looked at your data, I see no problem in using a variation of the file I emailed you.

The variation would be fairly simple, and would simply (at the click of a button) extract the required data (that you've described) to the four separate sheets.

I notice that your code includes &quot;deletion of Fund number column&quot;. Please appreciate that with Excel's Advanced Filter, it's real easy to &quot;delete&quot; columns - by simply including in the extraction only those columns you want - and you can change the order of the columns - simply by changing the order of the field names.

I hope this helps. I can email you a modified version of the same file. Or, if you've made modifications to a file you'd prefer I work on, you can email me the latest file.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[willyboy58]

Dale,

Thanks for the info, but I do not want to have to click a button. I want the procedure to work with other procedures that have already been called. All the different proc's together are called &quot;Prop1Compute&quot;

Prop1Compute takes a &quot;raw data&quot; file, separates the info, creates pivot tables, computes, deletes unneeded info and columns after they have been used, and quite a few other manipulations. This all works from start to finish without stopping in between.

Given that my programming skills are not as advanced as yours, I'll need to look over again what you sent to see if I can adjust it.

Thanks for the help.

Bill

 

[SkipVought]

Hey willie,

So you set up 4 filter criteria
Branch=1
Branch=2
Branch=3 AND Fund<>4
Fund=4

Filter to another location

Copy the data in that location to a new sheet...

set wsThis = activesheet
for i = 1 to 4
  select case i
    case 1
      'set criteria
      with Cells(1, 10)
        .value = "Branch"
        .offset(1,0).value = 1
        .offset(0,1).value = ""
        .offset(1,1).value = ""
     end with
    case 2
      'set criteria
      with Cells(1, 10)
        .value = "Branch"
        .offset(1,0).value = 2
        .offset(0,1).value = ""
        .offset(1,1).value = ""
      end with
    case 3
      'set criteria
      with Cells(1, 10)
        .value = "Branch"
        .offset(1,0).value = 3
        .offset(0,1).value = "Fund"
        .offset(1,1).value = 4
     end with
    case 4
      'set criteria
      with Cells(1, 10)
        .value = "Fund"
        .offset(1,0).value = 4
        .offset(0,1).value = ""
        .offset(1,1).value = ""
      end with
  end select
 'perform the advanced filter -- record it an stick it here

 'add a new sheet
  worksheets.add
  set wsNew = activesheet
 'copy the filtered data to a new sheet ASSUMING that the FILTERED LIST is in AA1
  wsthis.Cells(1, "AA").currentregion.copy _ 
    destination:=wsnew.[A1]
  wsthis.activate
next

this will get you pretty close.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com