Split worksheet into multiple sheets based on column data

Jeremy Joseph

New Member
Joined
Aug 4, 2021
Messages
2
Office Version
  1. 2013
Platform
  1. Windows
Hi,
I have a large file I would like assistance with, I have an inkling of macros and have been trying all over the net to find one to split my data into multiple sheets, by column data, all I found and tried to adjust gave me errors, hope I can get help here. The range is from A to Q and I need the data split firstly by column H ("Class") and after this initial split, I also want the "Roche Diagnostics (Inst)" Tab/Class split by Column C ("Ship To Name"). If It can be done with 2 separate Macros would be great
The number of rows will change on a daily basis and are usually upwards of 2500 and the tab name stays the same.

See link below for shared sheet sample.
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Jeremy Joseph

New Member
Joined
Aug 4, 2021
Messages
2
Office Version
  1. 2013
Platform
  1. Windows
I got the code for anyone that's interested here it is; If you can use it change the column from "H" to what you need and change the word "Class" to the header on the sheet you have. Also, put the sheet name on the tab, it runs smoother and faster. The green text are explanations and the red is what you should modify to suit your needs.

Sub Split_A()

'This is to trim/clean all the excess trailing and leading spaces
'including white spaces because data was retrieved from another software


Sheets("HES Backorder Details").Select
Columns("A:O").Select
Columns("A:O").EntireColumn.AutoFit
Dim r As Range
For Each r In ActiveSheet.UsedRange
v = r.Value
If v <> "" Then
If Not r.HasFormula Then
r.Value = Trim(v)
End If
End If
Next r

'this is to remove all symbols that cannot be used on tabs - /,\,[,]... etc

Selection.Replace What:="/", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="\", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'this is to split the data by the column you choose in this case column "H-Class",
'change to the column you want and replace the word "Class" with the header on your document


Const col = "H"
Const header_row = 1
Const starting_row = 2
Dim source_sheet As Worksheet
Dim destination_sheet As Worksheet
Dim source_row As Long
Dim last_row As Long
Dim destination_row As Long

Dim Class As String
Set source_sheet = ActiveSheet
last_row = source_sheet.Cells(source_sheet.Rows.Count, col).End(xlUp).Row
For source_row = starting_row To last_row
Class = source_sheet.Cells(source_row, col).Value
Set destination_sheet = Nothing
On Error Resume Next
Set destination_sheet = Worksheets(Class)
On Error GoTo 0
If destination_sheet Is Nothing Then
Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
destination_sheet.Name = Class
source_sheet.Rows(header_row).Copy destination:=destination_sheet.Rows(header_row)
End If
destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1
source_sheet.Rows(source_row).Copy destination:=destination_sheet.Rows(destination_row)
Next source_row

'This is to autofit all sheets and hide what is not required

Sheets(Array("HES Backorder Details", "Romsons International (Inst)", _
"Bd De Mexico (Inst)", "Intersurgical Limited (Inst)", "Baxter (Inst)", _
"Kodak (Inst)", "Roche Diagnostics (Inst)", "Merlin Medical (Inst)", _
"Neotech Products (Inst.)", "Tyco H-Care Inst. Medtronic Pr", _
"Sklar Instruments (Inst)", "Medtronics Logistics Us", _
"Ace H-Care- Sanacare (Inst)", "Alcon Centroamerica (Inst.)", "Pajunk (Inst.)", _
"Merit (Inst.)", "Bsn Medical La (Inst.)", "Advance Medgroup-Zimmer (Inst)", _
"Service (Inst)", "Teleflex Medical (Inst)", "Miscellaneous Hes (Inst)", _
"Utah Medical Products (Inst)", "Argon Medical Devices (Inst)", _
"Rockwell Medical Tech (Inst)", "Electroplast (Inst)")).Select
Sheets("Bd De Mexico (Inst)").Activate
Sheets(Array("Baxter (Govt)", "Intas Pharma (Govt)", "Rockwell (Govt)", _
"Masters Pharmaceuticals (Govt)", "Alcon Gov'T", "Janssen Cilag (Govt)", _
"Bsn Medical La (Govt)", "Genzyme Corporation (Govt)", "Romsons (Govt)", _
"Tyco H-Care (Gov) Medtronic Pr", "Idis Limited (Govt)", "Novartis Pharma (Govt)" _
, "Sandoz (Govt.)", "Roche Diagnostics (Govt)", "Kodak (Govt)")).Select Replace _
:=False
Cells.Select
Cells.EntireColumn.AutoFit
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
Columns("K:K").Select
Selection.EntireColumn.Hidden = True
Columns("O:O").Select
Selection.EntireColumn.Hidden = True
End Sub
 

Forum statistics

Threads
1,144,370
Messages
5,723,959
Members
422,529
Latest member
mbilal429

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
Top