PDA

View Full Version : How to split categorical data in Excel



maybe_dbs
02-28-2018, 03:30 AM
Some sample data:

Fruit Type | Price | Weight
Apple | $1 | 0.5
Pear | $2 | 0.3
Apple | $1.2 | 0.4
Banana | $1.1 | 0.2

I need a macro that does this:
Sort the data by Fruit Type (a categorical variable). Then, for all the Apples, copy and paste them somewhere. For all the Bananas, copy and paste them somewhere. For all the Pears, copy and paste them somewhere.
However, the solution needs to fit any Fruit Type (I won't know in advance what my categories are).
How can I solve this? I am open to using VBA. I cannot figure out how to split the data by categories. Is there any function or method that does this?

mancubus
02-28-2018, 04:33 AM
welcome to the forum.

test below code with a copy of your workbook.



Sub vbax_62122_split_data_based_on_ref_col_value()

Dim ws As Worksheet

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "split_sheet"
'create a temporary sheet to split the original table

With Worksheets("split_sheet")
.Cells.Clear
Worksheets("main_data").Cells(1).CurrentRegion.Copy .Cells(1)
'change main_data to the name of the sheet whic contains your data to be split
.Cells(1).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes

Do While .Range("A2") <> ""
On Error Resume Next
Set ws = Worksheets(.Range("A2"))
On Error GoTo 0
If ws Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Range("A2")
'if not exists, create a sheet for each category in column A to copy filtered rows to
Else
ws.Cells.ClearContents
'if exists, clear old data
End If

.Cells(1).AutoFilter Field:=1, Criteria1:=.Range("A2")
.AutoFilter.Range.Copy ws.Cells(1)
.UsedRange.Offset(1).SpecialCells(12).EntireRow.Delete
.AutoFilterMode = False
Loop
End With

Worksheets("split_sheet").Delete
'delete temp sheet

With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub