VBA to create worksheets

[chaddres]

I have a spreadsheet with data in columns A to J. I need a macro that I can paste the data into that takes the data and puts all data with the same Home Cost Number (column E) on a separate tab. There are some blank cost numbers at the top of the list that need to go on one tab, then the next cost number and associated data on a second tab, and so on. I have an undefined number of cost numbers and an undefined number of rows of data.

I am at a 100% loss on how/where to even begin. Even the list of cost numbers can change. I can rearrange the columns of my report output, if that helps. Anything that can be done is truly appreciated. I would even pay for help if someone could direct me to a resource.

Thank you in advance...
Chad

 

[vcoolio]

Hello Chaddres,

I'm assuming that you'd like a separate sheet created for each individual Home Cost Number code. However, in relation to the blanks, what is the intention here? To automatically create new worksheets there needs to be a value in the blank cells otherwise nothing will happen for these blank cells. Do you intend to give them a temporary value or name?

Cheerio,
vcoolio.

 

[chaddres]

Vcoolio:

We could fill them in with "0", right? That would work for me.

Chad

 

[vcoolio]

Hello Chad,

The next step is for you to upload a sample of your workbook. You can use this site's XL2BB tool (or upload your sample to a file sharing site such as Drop Box or WeTransfer then post the link to your file back here). Make sure that the sample is an exact replica of your actual workbook and if your data is sensitive then please use dummy data. Doing this will enable us to test any code in your supplied sample.

Cheerio,
vcoolio.

 

[chaddres]

Allocations.xlsx
	A	B	C	D	E	F	G	H	I
1	Position ID	Payroll Name	Location Description	Business Unit Description	Home Cost Number Code	Is Home Cost Number	Cost Number	Percentage	Allocations Status
2	UZK045426	Perez, Ana	Prince of Peace	Operations	2005-11002-FS166-301	No	2005-11007-FS195-301	17.00	Active
3	UZK045426	Perez, Ana	Prince of Peace	Operations	2005-11002-FS166-301	Yes	2005-11002-FS166-301	83.00	Active
4	UZK045472	Fechter, Timothy	Camp	Operations	1400-12001-FS358-301	Yes	1400-12001-FS358-301	100.00	Active
5	UZK045694	Knutson, David L	Mardak Administration	Government Affairs	1005-10001-FS358-301	Yes	1005-10001-FS358-301	100.00	Active
6	UZK045703	Wills, Jamar	North Division	Operations	1725-11002-FS124-301	Yes	1725-11002-FS124-301	100.00	Active
7	UZK045831	Roberts, Joel	Camp	Operations	1400-12001-FS358-301	Yes	1400-12001-FS358-301	100.00	Active
8	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1503-17007-FS175-301	10.00	Active
9	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1503-17008-FS183-301	25.00	Active
10	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1503-17014-FS204-301	35.00	Active
11	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1701-11002-FS100-301	5.00	Active
12	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1708-11002-FS107-301	5.00	Active
13	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1713-11002-FS112-301	5.00	Active
14	UZK046100	Ragland, Veronica S	Mary Ryan	Operations	1503-11001-FS358-301	No	1716-11002-FS115-301	5.00	Active
1

 

[chaddres]

Allocations.xlsx
	A	B	C	D	E	F	G	H	I
1	Position ID	Payroll Name	Location Description	Business Unit Description	Home Cost Number Code	Is Home Cost Number	Cost Number	Percentage	Allocations Status
2	UZK915611	Fine, Alison Elisabeth				Yes		100.00	Active
3	UZK917651	Bracey, Carol Jean	Clarke			Yes		100.00	Active
4	UZK917998	Hearn, Reginald M	North Division	Operations		Yes		100.00	Active
5	UZK910822	Mcclain-Kelly, Dana J	Clarke	Programs	1001-17003-FS358-301	No	3106-17003-FS174-301	60.00	Active
6	UZK910822	Mcclain-Kelly, Dana J	Clarke	Programs	1001-17003-FS358-301	Yes	1001-17003-FS358-301	40.00	Active
7	UZK913200	Lewis, Deonte M	Mardak Administration	Community Affairs	1002-10001-FS358-301	Yes	1002-10001-FS358-301	100.00	Active
8	UZK916569	Crain-Castle, Emily Kay	Grantosa	Operations	1002-10001-FS358-301	Yes	1002-10001-FS358-301	100.00	Active
9	UZK918012	Cazares, Caren	Mitchell	Community Affairs	1002-10001-FS457-311	Yes	1002-10001-FS457-311	100.00	Active
10	UZK913718	Aronson, Marisa E	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
11	UZK917965	Kwiatkowski, Marta	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
12	UZK917983	Holentunder, Tyler A	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
13	UZK917993	Saepharn, Kao F	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
14	UZK918053	Konieczki, Jordan M	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
15	UZK918078	Krause, Abigail S	Mardak Administration	Finance	1004-10001-FS358-301	No	1301-10001-FS358-301	50.00	Active
16	UZK918078	Krause, Abigail S	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	50.00	Active
17	UZK918105	Walls, Shawntay M	Mardak Administration	Finance	1004-10001-FS358-301	Yes	1004-10001-FS358-301	100.00	Active
18	UZK045694	Knutson, David L	Mardak Administration	Government Affairs	1005-10001-FS358-301	Yes	1005-10001-FS358-301	100.00	Active
19	UZK912933	Schmidlkofer, Joseph Franklin	Mardak Administration	Government Affairs	1005-10001-FS358-301	No	1400-12001-FS178-301	20.00	Active
1

 

[vcoolio]

Hello Chad,
Thanks for that.

See if the following code does the task for you:-

Sub Test()

              Dim i As Integer, lr As Long
              Dim sh As Worksheet, ws As Worksheet, ar As Variant
        
              Application.ScreenUpdating = False
              
              Set sh = Sheet1
              lr = sh.Range("A" & Rows.Count).End(xlUp).Row
              sh.Range("E1:E" & lr).AdvancedFilter 2, , sh.[X1], 1  'Unique values moved temporarily to Column X.
              sh.Range("X2", sh.Range("X" & sh.Rows.Count).End(xlUp)).Sort [X2], 1 'Unique values sorted.
              ar = sh.Range("X2", sh.Range("X" & sh.Rows.Count).End(xlUp))
              
              For i = 1 To UBound(ar)
                    If Not Evaluate("ISREF('" & CStr(ar(i, 1)) & "'!A1)") Then
                    Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ar(i, 1)
              End If
                    
              Set ws = Sheets(CStr(ar(i, 1)))
                    
              With sh.[A1].CurrentRegion
                    .AutoFilter 5, ar(i, 1)
                    .Copy ws.[A1]
                    .AutoFilter
              End With
                    ws.Columns.AutoFit
              Next i

             sh.Columns("X").Clear
             Application.Goto Sheet1.[A1]
             Application.ScreenUpdating = True

End Sub

The code temporarily uses Column X as a helper column to extract all unique values from Column E then sorts them and moves them into an array.
It then creates new individual sheets for each Home Cost Number Code without duplication and copies all data to it's individual sheet, including the headings.
Before you run the code, manually enter a text value into the blank cells in Column E, e.g. "A000". This will enable a new sheet to be created for the 'non-code' entries in Column E.
This can be done within the code, but first just see if all this works for you.

I hope that this helps.

Cheerio,
vcoolio.

 

[chaddres]

Thank you so much!

 

[vcoolio]

You're welcome Chad. I'm glad to have been able to assist.

Cheerio,
vcoolio.