Split Excel Data into Separate Tabs based on Building Names

[ShwetaD]

Hi, I have data in excel that needs to be split in separate tabs based on the building name. can someone please advise how can I create a macro or vb code for this?

AssetID	Building	Level1	Level2	Level3	Level4	AssetLabel	AssetLocation	MoreSpecificLocation
1​	Bldg1	D Services	D30 HVAC	D3040 Heat HVAC Distribution Systems	D3041 Air Distribution Systems	Air Curtain per 1,000 CFM	Interior
2​	Bldg2	D Services	D20 Plumbing	D2090 Other Plumbing Systems	D2094 Pool Piping and Equipment	Pool Filters	Mechanical Room	Spa
3​	Bldg3	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Restrooms	Ampitheater Concessions
4​	Bldg4	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Mechanical Room	Pool
5​	Bldg4	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Interior	Grill House
6​	Bldg4	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Interior	Rival House
7​	Bldg1	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Interior
8​	Bldg1	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Interior	Prep Storeage
9​	Bldg1	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Single Compartment Stainless Sink	Interior
10​	Bldg1	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Sink _ Integral with countertop	Interior	Banquet Kitchen
11​	Bldg1	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Sink _ Integral with countertop	Interior
12​	Bldg2	D Services	D20 Plumbing	D2010 Plumbing Fixtures	D2014 Sinks	Sink _ Integral with countertop	Interior	Ballroom

 

[DanteAmor]

In the macro, change "Sheet1" to the name of your sheet.
I'm assuming the headers are in row 1 and the data starts in row 2.

Try this:

Sub create_worksheets()
  Dim c As Range, sh As Worksheet, ky As Variant
  Set sh = Sheets("Sheet1")
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("B2", sh.Range("B" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      sh.Range("A1").AutoFilter Columns("B").Column, ky
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      sh.AutoFilter.Range.EntireRow.Copy Range("A1")
    Next ky
  End With
  sh.Select
  sh.ShowAllData
End Sub

 

[ShwetaD]

Hi,

The above code gives an error on the line sh.ShowAllData

Could someone please advise if the above data is to be split into different excel files based on building names then what the code would be?

Thank you

 

[DanteAmor]

The above code gives an error on the line sh.ShowAllData

Delete that line. But that's not the problem, really the problem is:
Your example is not very complete.
In which column are the buildings?
In which row does your data start?
The macro assumes that the buildings are in column B and start at row 2. It also assumes that the data is on the sheet named "Sheet1"
If not, you should give a more complete example, use the XL2BB tool.
I guess we'll hear from you in 18 days.

f the above data is to be split into different excel files

Your request are tabs not excel files.

 

[DanteAmor]

f the above data is to be split into different excel files

Your request are tabs not excel files.

 

[ShwetaD]

Hey,
My example was only to provide a sample. Your assumptions are correct i.e building name is in column B, the headers are in row 1 and the data starts from row 2. Sheet name is Sheet1.

My original question was to split the data in different tabs and thanks for providing the answer.

However, in this scenario what is happening is the macro creates multiple tabs using the above code and then I have to manually move the tab into a new file and save it separately. Sometimes I have 70+ tabs and it is a long manual exercise. So I was wondering if someone could help in writing a code where the data splits into separate excel files rather than into tabs.

Hope that makes sense now.

 

[DanteAmor]

My original question was to split the data in different tabs and thanks for providing the answer.

You should start by commenting that the response resolved your first request and will not return after 18 days claiming that the macro doesn't work.

Then kindly request that changes be made to the macro.

Try this:

Sub create_workbooks()
  Dim c As Range, sh As Worksheet, ky As Variant
  Dim wb2 As Workbook
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set sh = Sheets("Sheet1")
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("B2", sh.Range("B" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      sh.Range("A1").AutoFilter Columns("B").Column, ky
      Set wb2 = Workbooks.Add
      sh.AutoFilter.Range.EntireRow.Copy wb2.Sheets(1).Range("A1")
      wb2.SaveAs ThisWorkbook.Path & "\" & ky & ".xlsx"
      wb2.Close False
    Next ky
  End With
  sh.Select
  sh.ShowAllData
  Application.ScreenUpdating = True
End Sub

 

[ShwetaD]

That worked perfectly. Thank you!