Creating batches of data but without crossover on certain columns

[davey4444]

Hello, I will have a set of 10,000+ rows (and 5 fixed columns) which I need to put into sets of 999, ideally in worksheets of their own. I have found a few examples of how to do this to create individual files but not sheets. Additionally, I cannot have any crossover in some of my data, so for example below, even though the Ford Fiesta would usually appear in batch #1 (with batch #1 being rows 2-1000), I will need it to be moved into batch #2 so that it sits with the other Ford. Therefore it does not matter if my batches are not 999 rows exactly (plus header row), but they cannot be over.

Row Number	Make	Model	Cost	Date
1000	Ford	Fiesta	10000	1/1/20
1001	Ford	Focus	15000	1/1/20
1002	Fiat	500	20000	1/1/20

Any assistance in helping with the VBA for this would be most appreciated.

 

[QuietRiot]

How about by Make and Model?

Sub MoveToSheets()
    Dim wsAll As Worksheet
    Dim wsCrit As Worksheet
    Dim wsNew As Worksheet
    Dim LasttRow As Long
    Dim LastRowCrit As Long
    Dim q As Long
    
    ' Main sheet name
    Set wsAll = Worksheets("Sheet1")
    ' Get the last row
    LasttRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wsCrit = Worksheets.Add
    
    ' Columns B & C has the criteria
    wsAll.Range("B1:C" & LasttRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("B1:C1"), Unique:=True
    ' Get the last row
    LastRowCrit = wsCrit.Range("B" & Rows.Count).End(xlUp).Row
    For q = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = wsCrit.Range("B2") & " " & wsCrit.Range("C2")
        wsAll.Rows("1:" & LasttRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("B1:C2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next q
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
End Sub

 

[davey4444]

How about by Make and Model?

Sub MoveToSheets()
    Dim wsAll As Worksheet
    Dim wsCrit As Worksheet
    Dim wsNew As Worksheet
    Dim LasttRow As Long
    Dim LastRowCrit As Long
    Dim q As Long
   
    ' Main sheet name
    Set wsAll = Worksheets("Sheet1")
    ' Get the last row
    LasttRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
   
    Set wsCrit = Worksheets.Add
   
    ' Columns B & C has the criteria
    wsAll.Range("B1:C" & LasttRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("B1:C1"), Unique:=True
    ' Get the last row
    LastRowCrit = wsCrit.Range("B" & Rows.Count).End(xlUp).Row
    For q = 2 To LastRowCrit
   
        Set wsNew = Worksheets.Add
        wsNew.Name = wsCrit.Range("B2") & " " & wsCrit.Range("C2")
        wsAll.Rows("1:" & LasttRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("B1:C2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
       
    Next q
   
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
End Sub

Hi, thanks for the reply. Sorry but my example should have been clearer, I actually have SKU prefixes rather than car makes and there will be 1000s of individual ones in column A which would be impractical. I think that I need something like this - How to split spreadsheet into multiple spreadsheets with set number of rows? but also include in it a check so that the same SKU prefix does not get included in different 'batches' or splits.

 

[QuietRiot]

Can you post a better example with how the data actually looks?

 

[davey4444]

Thanks for the reply. I've put in a set of data below, the data needs to be split on record #994 rather than #999 because otherwise SKU Prefix 94846175757 would be across two sets of 999 records.

SKU Prefix	SKU Suffix	Value A	Value B	Value C	Record #
94846172628​	30​	000001	000001	G602	975​
94846172628​	40​	000001	000001	G602	976​
94846174329​	110​	000009	000008	G089	977​
94846174329​	100​	000009	000008	G089	978​
94846174329​	90​	000009	000008	G089	979​
94846174329​	80​	000009	000008	G089	980​
94846174329​	70​	000009	000008	G089	981​
94846174329​	60​	000009	000008	G089	982​
94846174329​	50​	000009	000008	G089	983​
94846174329​	40​	000009	000008	G089	984​
94846174329​	30​	000009	000008	G089	985​
94846174329​	20​	000009	000008	G089	986​
94846174329​	10​	000009	000008	G089	987​
94846174913​	10​	000010	000008	G604	988​
94846174913​	20​	000010	000008	G604	989​
94846174913​	30​	000010	000008	G604	990​
94846174913​	40​	000010	000008	G604	991​
94846174913​	50​	000010	000008	G604	992​
94846174913​	60​	000010	000008	G604	993​
94846174913​	70​	000010	000008	G604	994​
94846175757​	10​	000008	000007	G119	995​
94846175757​	20​	000008	000007	G119	996​
94846175757​	30​	000008	000007	G119	997​
94846175757​	40​	000008	000007	G119	998​
94846175757​	50​	000008	000007	G119	999​
94846175757​	60​	000008	000007	G119	1000​
94846176182​	90​	000002	000003	G610	1001​
94846176182​	100​	000002	000003	G610	1002​
94846176182​	70​	000002	000003	G610	1003​
94846176182​	60​	000002	000003	G610	1004​
94846176182​	50​	000002	000003	G610	1005​
94846176182​	40​	000002	000003	G610	1006​
94846176182​	32​	000002	000003	G610	1007​
94846176182​	31​	000002	000003	G610	1008​
94846176182​	30​	000002	000003	G610	1009​
94846176182​	20​	000002	000003	G610	1010​
94846176182​	10​	000002	000003	G610	1011​