split data from sheet into multiple sheets based on first two letters

[abdo meghari]

hi
I would split data from sheet tires into multiple sheets based on first for two letters (FS,BS.....) and when split data should arrange data the numbers from small to big.
so as you see in sheet BS when arrange should search the less number after R and arrange to big and should search the less number in the beginning item before letter R and arrange to big.
and should replace data in divided sheet when change or add new data in sheet TIRES.
original data in sheet TIRES

list1.xlsx
	A	B	C
1	ITEM	BRAND	QTY
2	1	BS 175/70R13 B25 INDO	230
3	2	BS 175/70R13 EP150 THI	123
4	3	BS 195/60R15 AR20 INDO	2300
5	4	BS 195/60R15 EP150 THI	500
6	5	BS 195/60R15 T001 JAP	1535
7	6	BS 195/60R15 150EZ THI	2570
8	7	BS 195/65R15 MY02 THI	3605
9	8	BS 205/70R15 694 JAP	4640
10	9	BS 185/70R13 EP150 INDO	5675
11	10	BS 175/65R14 EP150 THI	6710
12	11	BS 175/65R14 B25 INDO	7745
13	12	BS 175/70R14 EP150 THI	8780
14	13	BS 175/70R14 MY02 THI	9815
15	14	BS 185/65R14 TEC THI	10850
16	15	BS 185/65R14 150EZ INDO	11885
17	16	BS 185/65R14 EP150 INDO	12920
18	17	BS 195/70R14 150EZ INDO	13955
19	18	BS 185/65R15 TC10 INDO	14990
20	19	BS 185/65R15 T005 INDO	16025
21	20	BS 185/65R15 T01 JAP	17060
22	21	BS 185/65R15 B250 JAP	18095
23	22	FS 205/55R16 RE003 THI	24305
24	23	FS 205/65R15 EP150 INDO	25340
25	24	FS 205/65R15 MY02 THI	26375
26	25	FS 195/65R15 EP150 THI	27410
27	26	FS 195/65R15 EP150 JAP	28445
28	27	FS 195/65R15 T001 JAP	29480
29	28	FS 195/55R16 EP300 THI	30515
30	29	FS 205/65R15 TZ700 JAP	31550
TIRES

result after split for each sheet

list1.xlsx
	A	B	C
1	ITEM	BRAND	QTY
2	1	FS 195/65R15 EP150 THI	27410
3	2	FS 195/65R15 EP150 JAP	28445
4	3	FS 195/65R15 T001 JAP	29480
5	4	FS 205/65R15 EP150 INDO	25340
6	5	FS 205/65R15 MY02 THI	26375
7	6	FS 205/65R15 TZ700 JAP	31550
8	7	FS 195/55R16 EP300 THI	30515
9	8	FS 205/55R16 RE003 THI	24305
FS

list1.xlsx
	A	B	C
1	ITEM	BRAND	QTY
2	1	BS 175/70R13 B25 INDO	230
3	2	BS 175/70R13 EP150 THI	123
4	3	BS 185/70R13 EP150 INDO	5675
5	4	BS 175/65R14 EP150 THI	6710
6	5	BS 175/65R14 B25 INDO	7745
7	6	BS 175/70R14 EP150 THI	8780
8	7	BS 175/70R14 MY02 THI	9815
9	8	BS 185/65R14 TEC THI	10850
10	9	BS 185/65R14 150EZ INDO	11885
11	10	BS 185/65R14 EP150 INDO	12920
12	11	BS 195/70R14 150EZ INDO	13955
13	12	BS 185/65R15 TC10 INDO	14990
14	13	BS 185/65R15 T005 INDO	16025
15	14	BS 185/65R15 T01 JAP	17060
16	15	BS 185/65R15 B250 JAP	18095
17	16	BS 195/60R15 AR20 INDO	2300
18	17	BS 195/60R15 EP150 THI	500
19	18	BS 195/60R15 T001 JAP	1535
20	19	BS 195/60R15 150EZ THI	2570
21	20	BS 195/65R15 MY02 THI	3605
22	21	BS 205/70R15 694 JAP	4640
BS

 

[ranman256]

paste code into a module then run ParseData()
tho for some reason the sort isn't working, so I commented it out: SortData

Option Explicit

Public Sub ParseData()
Dim sName As String
Dim wsSrc As Worksheet, wsTarg As Worksheet
Dim colNames As New Collection
Dim iRows As Long, iRows2 As Long
Dim n As Integer
On Error GoTo errPars
Set wsSrc = ActiveSheet
Range("d1").Value = "sort"
Range("b2").Select
iRows = ActiveSheet.UsedRange.Rows.Count
'collect sort values
While ActiveCell.Value <> ""
      sName = Left(ActiveCell.Value, 2)
      ActiveCell.Offset(0, 2).Value = sName
      If sName <> "" Then colNames.Add sName, sName
   
      ActiveCell.Offset(1, 0).Select  'next row
Wend

'=copy data to its own sheet
For n = 1 To colNames.Count
   Range("A1").Select
    Selection.AutoFilter   'filter on
    ActiveSheet.Range("$A$1:$D$" & iRows).AutoFilter Field:=4, Criteria1:=colNames(n)
    Range("A1:D" & iRows).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveSheet.Name = colNames(n)
    Application.CutCopyMode = False

   Range("A1").Select
   iRows2 = ActiveSheet.UsedRange.Rows.Count
   
      'error here for some reason during sort
   'sortData iRows2
   
   FitCols
   wsSrc.Activate
   Selection.AutoFilter  'filter off
   
Next
  'show results
'wsTarg.Activate
MsgBox "Done"
Exit Sub
errPars:
If Err = 457 Then
   Resume Next
Else
MsgBox Err.Description, , Err
End If
Exit Sub
Resume
End Sub
Sub sortData(ByVal pvRows)
Dim ws As Worksheet
'---sort data for export
Set ws = ActiveSheet
    Range("b2").Select
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=Range("B2:D" & pvRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=Range("C2:C" & pvRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange Range("A1:D" & pvRows)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub FitCols()
    Columns("A:A").ColumnWidth = 4.29
    Columns("B:B").ColumnWidth = 40.29
    Columns("C:C").ColumnWidth = 10.43
    Columns("D:D").ColumnWidth = 4.29
    Cells.Select
    Selection.RowHeight = 16.5
    Range("A1").Select
End Sub

 

[abdo meghari]

thanks and I appreciate your help, but unfortunately there are two problems
first doesn't arrange as in OP into sheet FS. this is what I got based on your code

w.xlsm
	A	B	C
1	ITEM	BRAND	QTY
2	22	FS 205/55R16 RE003 THI	24305
3	23	FS 205/65R15 EP150 INDO	25340
4	24	FS 205/65R15 MY02 THI	26375
5	25	FS 195/65R15 EP150 THI	27410
6	26	FS 195/65R15 EP150 JAP	28445
7	27	FS 195/65R15 T001 JAP	29480
8	28	FS 195/55R16 EP300 THI	30515
9	29	FS 205/65R15 TZ700 JAP	31550
FS

second if I run macro repeatedly it gives error . it should update when I add new data or change in sheet TIRES when every time run the macro .

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: split data from sheet into multiple sheets based on first two letters
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[abdo meghari]

sorry Moderator
split data from sheet into multiple sheets based on first two letters

​

 

[abdo meghari]

it's solved .