Subsetting a worksheet with a macro and/or VBA.

B

Bob Fraser

New Member
Joined
Dec 24, 2005
Messages
7
Subset (divide) the first worksheet (Sheet1) into separate sheets by a variable(District)
Copy each to its own new worksheet and name the worksheet for the variable ("One", "Two", etc.).
The rows per District and the number of Districts will vary.
Background: Excel 2000
Product is to be Counted by School and Cost is Summed by School -
so manually this is done with two Pivot Tables which are Copy Pasted by District
to have Count and Sum on one row per Product.

Thanks, Bob Fraser




District School Teacher Product Cost
One Al Bill Ec 120
One Al **** Ec 120
One Al Joe Ec 120
One Al John Ec 120
One Al Sam Bu 60
One Al Sam Ec 120
One Be Art Ho 70
One Be Art Mo 300
One Be Ken Pl 80
One Ca Ann Ec 120
One Ca Ann Mn 100
Two Co Jill Ec 120
Two Co Jill Mn 100
Two Co Jill Pl 80
Two De Amy Bu 60
Two De Amy Mo 300
Two De Fran Ec 120
Two De Sue Ec 120
Two De Sue Ho 70
Three Ao Jed Bu 60
Three Ao Bob Bu 60
Three Gu Liz Ec 120
Three Gu LIz Ho 70
Three Gu Sal Bu 60
Three Mt Moe Ec 120
Three Mt Moe Mn 100
Three Mt Jim Bu 60
Three To Ray Ec 120
Three To Ray Ho 70
Three To Les Bu 60
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
hey Bob, welcome to the board

Near as I can tell, what you're looking for is to give each District its own sheet and have all the entries for each district on that sheet (i.e. District 1 will have all the entries that are from District 1).

So this is my stab at that...

Edit...now it is dynamic...I'm assuming that data always begins in A2 after the header row.

Code: 
Sub distribute()

Dim x
Set x = Range("A2")

Dim k
k = 0

Dim lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

Dim Rng1 As Range
Set Rng1 = Range(Cells(2, 1), Cells(lastrow, 1))

For Each cell In Rng1
      k = k + 1
          If cell = x And k = 1 Then
              ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
              ActiveSheet.Name = x
 
           ElseIf cell <> x And k > 1 Then
              k = 1
             ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
             ActiveSheet.Name = cell
             x = cell

         End If
Next



Dim yyy As Variant

With Rng1
    For Each Sheet In Worksheets
        Dim p
        p = 1
        yyy = Sheet.Name

        Set c = Rng1.Find(yyy, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.EntireRow.Copy Sheets(yyy).Cells(p, 1)
                    p = p + 1
                    Set c = .FindNext(c)
                Loop Until c.Address = firstAddress

            End If
    Next
End With
End Sub
 
Upvote 0
Hi poorwallace,
Thanks for the fast response. We're near Boston for Xmas but I'll test asap, and on real data in a couple of weeks. Spent the summer RVing in AK, most places with a road, excepting Juneau of course. Wish I could find an excuse to spend a year up there - even Fairbanks. Bob
 
Upvote 0
Even Fairbanks! :LOL: ...You might want to test out the code on a copy of your actual file to see if it does what you want first.

Enjoy the holidays
 
Upvote 0
Hi poorwallace,
I'm trying your code on my son-in-law's Excel 2003 and get a syntax error at k = k + 1. Have tried numerous changes, always the same - with an occassional "epected end of statement". Any ideas?
 
Upvote 0
Bob,

I assumed that your data was situated like this in the sheet. When I run the code on this data, it works fine. Given that the k = k + 1 line should generally not give you an error (as long as you dim it...), I'm thinking that your data might be situated differently, thus making the range I defined incorrect....Let me know how your data is situated...if it is situated the same way that I assumed, then I'm stumped, as the code works on my end (using Excel 2003).

HTH
Book1
ABCDE
1DistrictSchoolTeacherProductCost
2OneAlBillEc120
3OneAl****Ec120
4OneAlJoeEc120
5OneAlJohnEc120
6OneAlSamBu60
7OneAlSamEc120
8OneBeArtHo70
9OneBeArtMo300
10OneBeKenPl80
11OneCaAnnEc120
12OneCaAnnMn100
13TwoCoJillEc120
14TwoCoJillMn100
15TwoCoJillPl80
16TwoDeAmyBu60
17TwoDeAmyMo300
18TwoDeFranEc120
19TwoDeSueEc120
20TwoDeSueHo70
21ThreeAoJedBu60
22ThreeAoBobBu60
23ThreeGuLizEc120
24ThreeGuLIzHo70
25ThreeGuSalBu60
26ThreeMtMoeEc120
27ThreeMtMoeMn100
28ThreeMtJimBu60
29ThreeToRayEc120
30ThreeToRayHo70
Sheet1
 
Upvote 0
Hi poorwallace,
I had copypasted your code into a macro. Thinking there might be some hidden characters, I typed it in manually - and it worked! At least I got past K = K + 1.
Now it puts the first District on its own Wks, and then creates 19 empty numbered Wks. That first District does not have the header row (OK, Rng1 starts in row 2), and the first data row from the original Wks, is the last row in its District Wks. Did you get multiples?
Thanx again.
 
Upvote 0
Create a PivotTable with the District as a Page field. Then, use the Page Field option that splits the data based on the page field value into separate worksheets.

Bob Fraser said:
Subset (divide) the first worksheet (Sheet1) into separate sheets by a variable(District)
Copy each to its own new worksheet and name the worksheet for the variable ("One", "Two", etc.).
The rows per District and the number of Districts will vary.
Background: Excel 2000
Product is to be Counted by School and Cost is Summed by School -
so manually this is done with two Pivot Tables which are Copy Pasted by District
to have Count and Sum on one row per Product.

Thanks, Bob Fraser




District School Teacher Product Cost
One Al Bill Ec 120
One Al **** Ec 120
{snip}
Click to expand...
 
Upvote 0
Hi Tusharm,
Thanks for the new approach, but how is Page Field option set up to get the separate wks.
Bob
 
Upvote 0
Wow! With 2003 it sure is well hidden. After some amount of searching through the help file, on the help page for 'Display a different page in a PivotTable or PivotChart page field' is an innocuous looking 'Tip' at the bottom of the page. Showing the contents of the tip reveals "For some kinds of source data, you can display each PivotTable page on a separate worksheet. Click the report, click PivotTable on the PivotTable toolbar, and then click Show Pages. If the report has more than one page field, click the one you want."

Bob Fraser said:
Hi Tusharm,
Thanks for the new approach, but how is Page Field option set up to get the separate wks.
Bob
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Message Box VBA: Multiple Criteria
2
Replies
17
Views
2K
Yongle
Yongle
C
  • Question
3 payment some payments not made or paid in full
Replies
1
Views
389
CrashOD
C
P
  • Question
Copying and transposing data from one worksheet to another
Replies
1
Views
341
jdellasala
J
T
  • Question
Macros doing anything
Replies
0
Views
323
Thestalos
T
E
  • Solved
formula to return two columns of data adjacent to #N/A cell entry
Replies
3
Views
220
Fluff
Fluff

Forum statistics

Threads
1,214,566
Messages
6,120,266
Members
448,953
Latest member
Dutchie_1

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top