hi,
this there any way to simplify my code below
this there any way to simplify my code below
VBA Code:
Sub CN()
Dim SheetName As String
Dim LR As Long
Dim lngLastRow As Long
Dim LastRow1 As Long
Dim Source_Workbook As Workbook
Set Source_Workbook = ThisWorkbook
Sheets("Inventory").Select
ActiveSheet.UsedRange.AutoFilter Field:=2, Criteria1:="CN"
ActiveSheet.UsedRange.AutoFilter Field:=15, Criteria1:="ACTIVE"
Range("a1").Select
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName = ("CN")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.UsedRange.Select
Selection.Name = "TRange"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("TRange"), , xlYes).Name = SheetName
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = "Service By"
Range("AG2").Formula = "=VLOOKUP(W2,'Service By For CN'!A:B,2,FALSE)"
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = Sheets("Location mapping For CN").Range("b1").Value
Range("AH2").Formula = "=VLOOKUP(AC2,'Location mapping For CN'!A:D,2,FALSE)"
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = Sheets("Location mapping For CN").Range("c1").Value
Range("AI2").Formula = "=VLOOKUP(AC2,'Location mapping For CN'!A:D,3,FALSE)"
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = Sheets("Location mapping For CN").Range("d1").Value
Range("AJ2").Formula = "=VLOOKUP(AC2,'Location mapping For CN'!A:D,4,FALSE)"
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = "Final tab - Column B "
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("AK2:AK" & lngLastRow).Formula = "=""/""& AG2 & ""/"" & w2& ""/"""
ActiveWorkbook.Sheets(SheetName).ListObjects(SheetName).ListColumns.Add.Name = "MTM"
Range("AL2:AL" & lngLastRow).Formula = "=VLOOKUP(S2,'MTM For CN'!A:B,2,FALSE)"
Range("AG2:AL" & lngLastRow).Copy
Range("AG2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="M"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName1 = ("MVS")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName1
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A1").Select
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="F"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName2 = ("Futong")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName2
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="L"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName3 = ("Lanbaili")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName3
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="A"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName4 = ("Anchit")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName4
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="M"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName5 = ("Mingde")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName5
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=33, Criteria1:="BP"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName6 = ("BP")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName6
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("AL").Delete
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=7, Criteria1:="SERVICE"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName7 = ("Service Desk MA")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName7
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
ActiveSheet.ListObjects(SheetName).Range.AutoFilter Field:=7, Criteria1:="WARRANTY"
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
SheetName8 = ("Service Desk WA")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName8
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(SheetName).Select
ActiveSheet.ListObjects(SheetName).AutoFilter.ShowAllData
SheetName9 = ("ServiceDesk")
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName9
Worksheets("MTM For CN").Range("F1:AA1").Copy Worksheets(SheetName9).Range("A1")
Sheets(SheetName7).Columns.Range("T2:T" & lngLastRow).Copy Sheets(SheetName9).Range("E2")
Sheets(SheetName7).Columns.Range("AK2:AK" & lngLastRow).Copy Sheets(SheetName9).Range("G2")
Sheets(SheetName7).Columns.Range("AH2:AJ" & lngLastRow).Copy Sheets(SheetName9).Range("I2")
Sheets(SheetName7).Columns.Range("AC2:AC" & lngLastRow).Copy Sheets(SheetName9).Range("L2")
Sheets(SheetName7).Columns.Range("V2:V" & lngLastRow).Copy Sheets(SheetName9).Range("O2")
Sheets(SheetName7).Columns.Range("G2:G" & lngLastRow).Copy Sheets(SheetName9).Range("P2")
Sheets(SheetName7).Columns.Range("P2:Q" & lngLastRow).Copy Sheets(SheetName9).Range("S2")
Sheets(SheetName7).Columns.Range("AE2:AE" & lngLastRow).Copy Sheets(SheetName9).Range("V2")
Sheets(SheetName7).Columns.Range("AL2:AL" & lngLastRow).Copy
Sheets(SheetName9).Range("B2").PasteSpecial Paste:=xlPasteValues
LR = Cells(Rows.Count, 5).End(xlUp).Row
Sheets(SheetName8).Columns.Range("T2:T" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "E")
Sheets(SheetName8).Columns.Range("AK2:AK" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "G")
Sheets(SheetName8).Columns.Range("AH2:AJ" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "I")
Sheets(SheetName8).Columns.Range("AC2:AC" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "L")
Sheets(SheetName8).Columns.Range("V2:V" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "O")
Sheets(SheetName8).Columns.Range("G2:G" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "P")
Sheets(SheetName8).Columns.Range("P2:Q" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "Q")
Sheets(SheetName8).Columns.Range("AE2:AE" & lngLastRow).Copy Destination:=Sheets(SheetName9).Cells(LR + 1, "U")
Sheets(SheetName8).Columns.Range("AL2:AL" & lngLastRow).Copy
Sheets(SheetName9).Cells(LR + 1, "B").PasteSpecial Paste:=xlPasteValues
Range("c2:c" & Cells(Rows.Count, "B").End(xlUp).Row).Formula = "=VLOOKUP(b2,'MTM For CN'!b:D,2,FALSE)"
Range("d2:d" & Cells(Rows.Count, "B").End(xlUp).Row).Formula = "=VLOOKUP(b2,'MTM For CN'!b:D,3,FALSE)"
Range("c2:D" & lngLastRow).Copy
Range("c2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
LastRow1 = Range("L" & Rows.Count).End(xlUp).Row
Range("A2") = Worksheets("MTM For CN").Range("F2"): Range("A2:A" & LastRow1).FillDown
Range("F2") = Worksheets("MTM For CN").Range("K2"): Range("F2:F" & LastRow1).FillDown
Range("H2") = Worksheets("MTM For CN").Range("M2"): Range("H2:H" & LastRow1).FillDown
ActiveSheet.UsedRange.Select
Selection.Name = "TRange1"
Range("TRange1").Borders.LineStyle = xlContinuous
Range("TRange1").WrapText = True
Range("TRange1").EntireRow.RowHeight = 30
Range("TRange1").EntireColumn.ColumnWidth = 15
Application.DisplayAlerts = False
Sheets(SheetName7).Delete
Sheets(SheetName8).Delete
Application.DisplayAlerts = True
ActiveWorkbook.Worksheets(SheetName).ListObjects(SheetName).ListColumns("MTM").Delete
Sheets(Array(SheetName9, SheetName6, SheetName5, SheetName4, SheetName3, SheetName2, SheetName1, SheetName)).Move
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ServicedByPivot"
Application.DisplayAlerts = True
Set PSheet = Worksheets("ServicedByPivot")
Set DSheet = Worksheets(SheetName)
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="ServicedByPivot")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="ServicedByPivot")
With ActiveSheet.PivotTables("ServicedByPivot").PivotFields("Service By")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("ServicedByPivot").PivotFields("Install Owner")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("ServicedByPivot").AddDataField ActiveSheet.PivotTables( _
"ServicedByPivot").PivotFields("Serial Number"), "Count of Serial Number", xlCount
Range("b1").EntireColumn.ColumnWidth = 49
On Error Resume Next
Application.DisplayAlerts = False
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "LocationPivot"
Application.DisplayAlerts = True
Set PSheet = Worksheets("LocationPivot")
Set DSheet = Worksheets(SheetName)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="LocationPivot")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="LocationPivot")
With ActiveSheet.PivotTables("LocationPivot").PivotFields("Install Address")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("LocationPivot").AddDataField ActiveSheet.PivotTables( _
"LocationPivot").PivotFields("Serial Number"), "Count of Serial Number", xlCount
Range("b1").EntireColumn.ColumnWidth = 100
Source_Workbook.Activate
Sheets("Inventory").Select
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
Sheets("GenerateRep").Select
End Sub
Last edited by a moderator: