[color=darkgreen]'[/color]
'
[color=blue]Sub[/color] makeTruckRecord1()
[color=blue]Dim[/color] lr [color=blue]As[/color] [color=blue]Long[/color], rng [color=blue]As[/color] Range, c [color=blue]As[/color] Range, lc [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("unfiltered") [color=darkgreen]'set sheet name - Give abbreviation for "unfiltered" sheet in ThisWorkbook all Objects, Properties and Methods of Object Worksheet obtainable to view in the intellisense given after typing . Dot[/color]
[color=darkgreen]'Part 1) Optional Start Bit to Delete Sheets / Tabs------------[/color]
Application.DisplayAlerts = [color=blue]False[/color] [color=darkgreen]'Prevents being asked everytime if you really want to delete the Workbook[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=darkgreen]'Tempory worksheet name. ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/color]
[color=blue]For[/color] [color=blue]Each[/color] ws [color=blue]In[/color] ActiveWorkbook.Worksheets [color=darkgreen]'We could alternatively use something like ThisWorkbook, Workbooks("Itsname.xlxm")[/color]
[color=blue]If[/color] ws.Name <> "ASheetToKeep" And ws.Name <> wks1.Name [color=blue]Then[/color] [color=darkgreen]'Check that Worksheet name is not that of any that you want (Name property here returns name without .xlsm bit on end)[/color]
ws.Delete
[color=blue]Else[/color] [color=darkgreen]'Presumably then the worksheet name is That of the first sheet or any you wish to keep[/color]
[color=darkgreen]' do nothing (Don't delete it!)[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] ws
Application.DisplayAlerts = [color=blue]True[/color] [color=darkgreen]'Turn it back on[/color]
[color=darkgreen]'---End Bit to delete any Sheets / Tabs--------------------[/color]
[color=darkgreen]'Part 2) Produce New sheets based on valid Number Plates[/color]
lr = wks1.Cells(Rows.Count, "A").End(xlUp).Row
lc = 3
wks1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C20:C24"), CopyToRange:=wks1.Range("A" & lr + 2), Unique:=[color=blue]True[/color]
[color=blue]Set[/color] rng = wks1.Range("A" & lr + 3, wks1.Cells(Rows.Count, 1).End(xlUp))
[color=blue]For[/color] [color=blue]Each[/color] c [color=blue]In[/color] rng [color=darkgreen]' Each c is each range, that is to say each cell in the entire range rng[/color]
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).AutoFilter 1, c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
wks1.AutoFilterMode = [color=blue]False[/color]
[color=blue]Next[/color]
[color=darkgreen]'wks1.Range("A" & lr + 2, wks1.Cells(Rows.Count, 1).End(xlUp)).ClearContents 'empty extra takt on Unique values in LookUpColumn[/color]
[color=darkgreen]'End part to produce new sheets--------------------------[/color]
wks1.Activate [color=darkgreen]'Activate that sheet 1 just to see it[/color]
[color=blue]End[/color] [color=blue]Sub[/color]
[color=darkgreen]'[/color]
'
[color=blue]Sub[/color] makeTruckRecord2()
[color=blue]Dim[/color] lr [color=blue]As[/color] [color=blue]Long[/color], rng [color=blue]As[/color] Range, c [color=blue]As[/color] Range, lc [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("unfiltered") [color=darkgreen]'set sheet name - Give abbreviation for "unfiltered" sheet in ThisWorkbook all Objects, Properties and Methods of Object Worksheet obtainable to view in the intellisense given after typing . Dot[/color]
[color=darkgreen]'Part 1) Optional Start Bit to Delete Sheets / Tabs------------[/color]
Application.DisplayAlerts = [color=blue]False[/color] [color=darkgreen]'Prevents being asked everytime if you really want to delete the Workbook[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=darkgreen]'Tempory worksheet name. ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/color]
[color=blue]For[/color] [color=blue]Each[/color] ws [color=blue]In[/color] ActiveWorkbook.Worksheets [color=darkgreen]'We could alternatively use something like ThisWorkbook, Workbooks("Itsname.xlxm")[/color]
[color=blue]If[/color] ws.Name <> "ASheetToKeep" And ws.Name <> wks1.Name [color=blue]Then[/color] [color=darkgreen]'Check that Worksheet name is not that of any that you want (Name property here returns name without .xlsm bit on end)[/color]
ws.Delete
[color=blue]Else[/color] [color=darkgreen]'Presumably then the worksheet name is That of the first sheet or any you wish to keep[/color]
[color=darkgreen]' do nothing (Don't delete it!)[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] ws
Application.DisplayAlerts = [color=blue]True[/color] [color=darkgreen]'Turn it back on[/color]
[color=darkgreen]'---End Bit to delete any Sheets / Tabs--------------------[/color]
[color=darkgreen]'Part 2) Produce New sheets based on valid Number Plates[/color]
lr = wks1.Cells(Rows.Count, "A").End(xlUp).Row
lc = 3
wks1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C27:C28"), CopyToRange:=wks1.Range("A" & lr + 2), Unique:=[color=blue]True[/color]
[color=blue]Set[/color] rng = wks1.Range("A" & lr + 3, wks1.Cells(Rows.Count, 1).End(xlUp))
[color=blue]For[/color] [color=blue]Each[/color] c [color=blue]In[/color] rng [color=darkgreen]' Each c is each range, that is to say each cell in the entire range rng[/color]
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).AutoFilter 1, c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
wks1.AutoFilterMode = [color=blue]False[/color]
[color=blue]Next[/color]
[color=darkgreen]'wks1.Range("A" & lr + 2, wks1.Cells(Rows.Count, 1).End(xlUp)).ClearContents 'empty extra takt on Unique values in LookUpColumn[/color]
[color=darkgreen]'End part to produce new sheets--------------------------[/color]
wks1.Activate [color=darkgreen]'Activate that sheet 1 just to see it[/color]
[color=blue]End[/color] [color=blue]Sub[/color]
[color=darkgreen]'[/color]
'
[color=blue]Sub[/color] makeTruckRecord3()
[color=blue]Dim[/color] lr [color=blue]As[/color] [color=blue]Long[/color], rng [color=blue]As[/color] Range, c [color=blue]As[/color] Range, lc [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("unfiltered") [color=darkgreen]'set sheet name - Give abbreviation for "unfiltered" sheet in ThisWorkbook all Objects, Properties and Methods of Object Worksheet obtainable to view in the intellisense given after typing . Dot[/color]
[color=darkgreen]'Part 1) Optional Start Bit to Delete Sheets / Tabs------------[/color]
Application.DisplayAlerts = [color=blue]False[/color] [color=darkgreen]'Prevents being asked everytime if you really want to delete the Workbook[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=darkgreen]'Tempory worksheet name. ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/color]
[color=blue]For[/color] [color=blue]Each[/color] ws [color=blue]In[/color] ActiveWorkbook.Worksheets [color=darkgreen]'We could alternatively use something like ThisWorkbook, Workbooks("Itsname.xlxm")[/color]
[color=blue]If[/color] ws.Name <> "ASheetToKeep" And ws.Name <> wks1.Name [color=blue]Then[/color] [color=darkgreen]'Check that Worksheet name is not that of any that you want (Name property here returns name without .xlsm bit on end)[/color]
ws.Delete
[color=blue]Else[/color] [color=darkgreen]'Presumably then the worksheet name is That of the first sheet or any you wish to keep[/color]
[color=darkgreen]' do nothing (Don't delete it!)[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] ws
Application.DisplayAlerts = [color=blue]True[/color] [color=darkgreen]'Turn it back on[/color]
[color=darkgreen]'---End Bit to delete any Sheets / Tabs--------------------[/color]
[color=darkgreen]'Part 2) Produce New sheets based on valid Number Plates[/color]
lr = wks1.Cells(Rows.Count, "A").End(xlUp).Row
lc = 3
wks1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C30:C31"), CopyToRange:=wks1.Range("A" & lr + 2), Unique:=[color=blue]True[/color]
[color=blue]Set[/color] rng = wks1.Range("A" & lr + 3, wks1.Cells(Rows.Count, 1).End(xlUp))
[color=blue]For[/color] [color=blue]Each[/color] c [color=blue]In[/color] rng [color=darkgreen]' Each c is each range, that is to say each cell in the entire range rng[/color]
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).AutoFilter 1, c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
wks1.AutoFilterMode = [color=blue]False[/color]
[color=blue]Next[/color]
[color=darkgreen]'wks1.Range("A" & lr + 2, wks1.Cells(Rows.Count, 1).End(xlUp)).ClearContents 'empty extra takt on Unique values in LookUpColumn[/color]
[color=darkgreen]'End part to produce new sheets--------------------------[/color]
wks1.Activate [color=darkgreen]'Activate sheet 1 just to see it[/color]
[color=blue]End[/color] [color=blue]Sub[/color]
[color=darkgreen]'[/color]
'
[color=blue]Sub[/color] makeTruckRecord4()
[color=blue]Dim[/color] lr [color=blue]As[/color] [color=blue]Long[/color], rng [color=blue]As[/color] Range, c [color=blue]As[/color] Range, lc [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("unfiltered") [color=darkgreen]'set sheet name - Give abbreviation for "unfiltered" sheet in ThisWorkbook all Objects, Properties and Methods of Object Worksheet obtainable to view in the intellisense given after typing . Dot[/color]
[color=darkgreen]'Part 1) Optional Start Bit to Delete Sheets / Tabs------------[/color]
Application.DisplayAlerts = [color=blue]False[/color] [color=darkgreen]'Prevents being asked everytime if you really want to delete the Workbook[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=darkgreen]'Tempory worksheet name. ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/color]
[color=blue]For[/color] [color=blue]Each[/color] ws [color=blue]In[/color] ActiveWorkbook.Worksheets [color=darkgreen]'We could alternatively use something like ThisWorkbook, Workbooks("Itsname.xlxm")[/color]
[color=blue]If[/color] ws.Name <> "ASheetToKeep" And ws.Name <> wks1.Name [color=blue]Then[/color] [color=darkgreen]'Check that Worksheet name is not that of any that you want (Name property here returns name without .xlsm bit on end)[/color]
ws.Delete
[color=blue]Else[/color] [color=darkgreen]'Presumably then the worksheet name is That of the first sheet or any you wish to keep[/color]
[color=darkgreen]' do nothing (Don't delete it!)[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] ws
Application.DisplayAlerts = [color=blue]True[/color] [color=darkgreen]'Turn it back on[/color]
[color=darkgreen]'---End Bit to delete any Sheets / Tabs--------------------[/color]
[color=darkgreen]'Part 2) Produce New sheets based on valid Number Plates[/color]
lr = wks1.Cells(Rows.Count, "A").End(xlUp).Row
lc = 3
wks1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C34:C35"), CopyToRange:=wks1.Range("A" & lr + 2), Unique:=[color=blue]True[/color]
[color=blue]Set[/color] rng = wks1.Range("A" & lr + 3, wks1.Cells(Rows.Count, 1).End(xlUp))
[color=blue]For[/color] [color=blue]Each[/color] c [color=blue]In[/color] rng [color=darkgreen]' Each c is each range, that is to say each cell in the entire range rng[/color]
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).AutoFilter 1, c.Value
wks1.Range("A1", wks1.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
wks1.AutoFilterMode = [color=blue]False[/color]
[color=blue]Next[/color]
[color=darkgreen]'wks1.Range("A" & lr + 2, wks1.Cells(Rows.Count, 1).End(xlUp)).ClearContents 'empty extra takt on Unique values in LookUpColumn[/color]
[color=darkgreen]'End part to produce new sheets--------------------------[/color]
wks1.Activate [color=darkgreen]'Activate sheet 1 just to see it[/color]
[color=blue]End[/color] [color=blue]Sub[/color]
[color=darkgreen]'[/color]
'
'
)
