[color=darkblue]Option[/color] [color=darkblue]Explicit[/color] [color=green]'Not necerssary but good practice to keep computer memery usage to minimum (and helps show up errors)[/color]
[color=darkblue]Sub[/color] joeyc123AdvFiltZuNeuTab****()
Application.ScreenUpdating = [color=darkblue]False[/color] [color=green]'Not necerssary but speeds things up a bit, by turning screen updating off.[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] TheEnd [color=green]'If anything goes wrong go to the End instead of crashing.[/color]
[color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet [color=green]'ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/color]
[color=green]'Start Bit to Delete Sheets / Tabs------------[/color]
Application.DisplayAlerts = [color=darkblue]False[/color] [color=green]'Prevents being asked everytime if you really want to delete the Workbook[/color]
[color=darkblue]For[/color] [color=darkblue]Each[/color] ws [color=darkblue]In[/color] ActiveWorkbook.Worksheets
[color=darkblue]If[/color] ws.Name <> "FullDataSheet" [color=darkblue]Then[/color]
ws.Delete
[color=darkblue]Else[/color] [color=green]'Presumably then the worksheet name is FullDataSheet so[/color]
[color=green]' do nothing (Don't delete it!)[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]Next[/color]
Application.DisplayAlerts = [color=darkblue]True[/color] [color=green]'Turn it back on[/color]
[color=green]'End Bit to delete new Sheets / Tabs------------[/color]
[color=green]'Add new Worksheets---[/color]
[color=darkblue]Dim[/color] Record [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'Record name, not kept constant, used / updated in looping[/color]
[color=darkblue]Dim[/color] LastRecordRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'Assume initially you have no more than 255 Records. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647)[/color]
[color=darkblue]Let[/color] Worksheets.Add(After:=Worksheets(1)).Name = "Unique1" [color=green]'Add a Worksheet after the first, named Unique1 for now[/color]
[color=darkblue]Let[/color] LastRecordRow = Sheets("FullDataSheet").Range("C" & Rows.Count).End(xlUp).Row
Sheets("FullDataSheet").Range("C1:C" & LastRecordRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Unique1").Range("A1"), Unique:=[color=darkblue]True[/color] [color=green]'Copies entire L Column to first column in sheet2 (Tempory made "Unique1" sheet), The important bit is Unique:=True - that only copies unique bits[/color]
[color=green]'---------------------[/color]
[color=darkblue]Dim[/color] LastUnqRow [color=darkblue]As[/color] [color=darkblue]Long[/color], UqeRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'Rows in Tempory Unique sheet. long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647)[/color]
[color=darkblue]Let[/color] LastUnqRow = Worksheets("Unique1").Cells.Find(What:="*", After:=Worksheets("Unique1").Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [color=green]'Get last Unique Row for use in next loop. method: You starta at first cell then go backwards (which effectively starts at end of sheet. This allows for different excel versions with different available Row numbers)[/color]
[color=darkblue]For[/color] UqeRow = 2 [color=darkblue]To[/color] LastUnqRow [color=darkblue]Step[/color] 1 [color=green]'[/color]
'Make new sheet------------
[color=darkblue]If[/color] Sheets("Unique1").Cells(UqeRow, 1).Text <> "" [color=darkblue]Then[/color] [color=green]'Assuming a Record is there[/color]
[color=darkblue]Let[/color] Record = Sheets("Unique1").Cells(UqeRow, 1).Text [color=green]'Put name in Record variable[/color]
[color=darkblue]Let[/color] Worksheets.Add(After:=Worksheets(1)).Name = Record [color=green]'Add new worksheet with Record name[/color]
[color=darkblue]With[/color] Sheets("FullDataSheet") [color=green]'Copying data to new sheet----[/color]
.UsedRange.AutoFilter Field:=3, Criteria1:=Record [color=green]'Filter out everything except with that with the appropriate Record (makes visible based on the criteria only the stuff you want??)....[/color]
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Record).Range("A1") [color=green]', then combine it with SpecialCells to just copy that wot you see, (and then send it to the relavent new sheet , name n).. ( Idid notice that it works the same without the .SpecialCells(xlCellTypeVisible) bit, - but that mayjust be Excel “guessing wot you want” as it does, that is to say it copies by default wot is visible?- not too sure on that one yet.)[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color] [color=green]'-------------------------------------------------[/color]
[color=darkblue]With[/color] Sheets(Record).UsedRange [color=green]'Bit of simple Format Tidying up[/color]
.WrapText = [color=darkblue]False[/color]
.Columns.AutoFit
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Else[/color]
[color=green]'Do nothing if no Record given[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=green]'-----------------------------[/color]
[color=darkblue]Next[/color] UqeRow [color=green]'Go back and make another ner sheet[/color]
Sheets("FullDataSheet").AutoFilterMode = [color=darkblue]False[/color]
Application.DisplayAlerts = [color=darkblue]False[/color] [color=green]'Prevent being asked if you really want to delete Temporary Unique sheet[/color]
Sheets("Unique1").Delete [color=green]' delete the filtered Record name sheet as you do not need it any more[/color]
Application.DisplayAlerts = [color=darkblue]True[/color]
Application.ScreenUpdating = [color=darkblue]True[/color] [color=green]'Turn screen "back on" or screen is "dead"[/color]
[color=darkblue]Exit[/color] [color=darkblue]Sub[/color] [color=green]'We stop code here assuming it worked (or at least did not crash!)[/color]
TheEnd:
Application.ScreenUpdating = [color=darkblue]True[/color] [color=green]'Important to do this here so if anything goes wron then the screen updating is turned back on, ohterwisee the screen is dead[/color]
MsgBox (Err.Description) [color=green]'Print out error message in Message Box[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'joeyc123AdvFiltZuNeuTab****()[/color]