Any way to simplify the code

L

lemonboy

New Member
Joined
Apr 8, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
hi,

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:
Sort by date Sort by votes
TUY said:
Sorry, I make the wrong direction. Is LastRow1 = [L1].End(xldown).Row right?
Click to expand...


That looks from l1 down until it reaches a blank cell, if there is data after the blank cell it wont give the correct result for the last row. run the code below with the data in the example below

VBA Code: 
Sub xxxxx2()
MsgBox Range("L" & Rows.Count).End(xlUp).Row
MsgBox [L1].End(xlDown).Row
End Sub

Book1
L
1Order ID
2106-10-N64
3103-2-N19
4109-11-N40
5108-13-F29
6106-6-N93
7104-24-N55
8
9107-16-N07
10105-8-F92
11108-29-N02
12104-13-N73
13103-25-N93
14106-16-F70
15106-25-F43
16110-15-F26
17104-12-N44
18108-30-F03
19103-28-N66
20105-21-F44
21107-5-F66
Sheet1
 
Last edited:
Upvote 0

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
MARK858 said:
That looks from l1 down until it reaches a blank cell, if there is data after the blank cell it wont give the correct result for the last row. run the code below with the data in the example below

VBA Code: 
Sub xxxxx2()
MsgBox Range("a" & Rows.Count).End(xlUp).Row
MsgBox [L1].End(xlDown).Row
End Sub

Book1
L
1Order ID
2106-10-N64
3103-2-N19
4109-11-N40
5108-13-F29
6106-6-N93
7104-24-N55
8
9107-16-N07
10105-8-F92
11108-29-N02
12104-13-N73
13103-25-N93
14106-16-F70
15106-25-F43
16110-15-F26
17104-12-N44
18108-30-F03
19103-28-N66
20105-21-F44
21107-5-F66
Sheet1
Click to expand...
Thanks!
 
Upvote 0
You're welcome (btw, I originally accidently left the first part of the code saying
Rich (BB code): 
MsgBox Range("a" & Rows.Count).End(xlUp).Row
it should have been
Rich (BB code): 
MsgBox Range("L" & Rows.Count).End(xlUp).Row
, now edited)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
VBA to loop through sheets and copy to new workbook including the pivot tab
Replies
0
Views
189
simont1975
S
M
  • Question
Table issue with VBA
Replies
0
Views
57
Mike2
M
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
99
willow1985
willow1985
G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
276
GardianAngelUK
G
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
341
Agnarr
Agnarr

Forum statistics

Threads
1,214,833
Messages
6,121,857
Members
449,051
Latest member
excelquestion515

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top