vba - Splitting Large Dataset into multiple tabs by column -

i trying split large data set (15 columns 360,000+ rows) multiple tabs values inside column in excel. using following script, macro not seemingly able handle amount of data (excel freezes). have used script on shortened version of data , works perfectly. advice such large dataset great.

sub splitdata() const namecol = "o" const headerrow = 1 const firstrow = 2 dim srcsheet worksheet dim trgsheet worksheet dim srcrow long dim lastrow long dim trgrow long dim student string application.screenupdating = false set srcsheet = activesheet lastrow = srcsheet.cells(srcsheet.rows.count, namecol).end(xlup).row srcrow = firstrow lastrow     student = srcsheet.cells(srcrow, namecol).value     set trgsheet = nothing     on error resume next     set trgsheet = worksheets(student)     on error goto 0     if trgsheet nothing         set trgsheet = worksheets.add(after:=worksheets(worksheets.count))         trgsheet.name = student         srcsheet.rows(headerrow).copy destination:=trgsheet.rows(headerrow)     end if     trgrow = trgsheet.cells(trgsheet.rows.count, namecol).end(xlup).row + 1     srcsheet.rows(srcrow).copy destination:=trgsheet.rows(trgrow) next srcrow application.screenupdating = true 

end sub

further comments, can speed entire code if use .removeduplicates , .autofilter

logic: logic copy data col 15 ("o") new sheet. let's col a. use .removeduplicates delete duplicate values. once done, have unique names worksheet. check if sheet names exist in loop , if don't create sheets in one go.

after sheets created, use autofilter filter out data based on sheet names can picked temp sheet. don't need loop through every row. can mass copying , faster copying every row :)

code (untested)

i wrote code , hence not tested. let me know if errors. have commented code shouldn't have problem understanding it.

sub sample()     dim ws worksheet, wstemp worksheet     dim lrow long, colno long, long     dim namecol string, strcriteria string     dim myrange range      namecol = "o"      '~~> change relevant sheet     set ws = thisworkbook.sheets("sheet1")      '~~> add temp sheet     thisworkbook.sheets.add     set wstemp = activesheet      ws         lrow = .cells(.rows.count, namecol).end(xlup).row         colno = .range(namecol & 1).column          '~~> copy column temp sheet         .columns(colno).copy wstemp.columns(1)          set myrange = .range("a1:o" & lrow)     end      wstemp         '~~> remove duplicates         .columns(1).removeduplicates columns:=1, header:=xlyes          lrow = .cells(.rows.count, 1).end(xlup).row          = 2 lrow             '~~> check if sheet exists             if not sheetexists(.cells(i, 1).value)                 '~~> create new sheet                  thisworkbook.sheets.add.name = (.cells(i, 1).value)             end if         next     end       ws         '~~> loop though sheet names in temp sheet         = 2 lrow             strcriteria = wstemp.cells(i, 1)              'remove filters             .autofiltermode = false              '~~> filter range , mass copying relevant sheet             myrange                 .autofilter field:=15, criteria1:=strcriteria                  .offset(1, 0).specialcells(xlcelltypevisible).entirerow.copy _                 thisworkbook.sheets(strcriteria).rows(1)             end              'remove filters             .autofiltermode = false         next     end      '~~> delete temp sheet     application.displayalerts = false     wstemp.delete     application.displayalerts = false end sub  '~~> function check if sheet exists function sheetexists(sname string) boolean     dim sht worksheet      on error resume next     set sht = thisworkbook.sheets(sname)     on error goto 0      if not sht nothing sheetexists = true end function