none
Produced Excel-file is too big using VBA RRS feed

  • Question

  • Hi,

    I have to build a Excel file every month, with 11 sheets which contains data. When I do this by hand, the file size is about 1,000 KB (with all the sheets and data).

    Now I wanted to let Excel build this file for me, which would save me 8 hours of work. Only when I do this, the file-size after sheet number 4 is more than 200,000 KB... With this, Excel can not complete the task due to memory problems.

    Is there a way to solve this?

    The code:

    Sub DataSheet()
    
    Dim ShapePP As Object
    Dim rSource As Range
    
        'Defining Names
        Set WB = ThisWorkbook
        Set WSIndex = WB.Worksheets(1)
        Set WSDelay = WB.Worksheets(3)
        Set WSNumOfOpp = WB.Worksheets(6)
        Set WSCompl = WB.Worksheets(5)
        Set WSUGT = WB.Worksheets(4)
        Set NewBook = Workbooks.Add
        
        'Defining ATA-names
        ATARankOne = WSIndex.Cells(3, 5)
        ATARankTwo = WSIndex.Cells(4, 5)
        ATARankThree = WSIndex.Cells(5, 5)
        ATARankFour = WSIndex.Cells(6, 5)
        ATARankFive = WSIndex.Cells(7, 5)
        ATARankSix = WSIndex.Cells(8, 5)
        ATARankSeven = WSIndex.Cells(9, 5)
        ATARankEight = WSIndex.Cells(10, 5)
        ATARankNine = WSIndex.Cells(11, 5)
        ATARankTen = WSIndex.Cells(12, 5)
        
    'Create new workbook and add sheets with specific names (the names of the Top 10 ranking).
    'Sheet 1, 2 and 3 are already addded, so these I have to use.
    
        With NewBook
            .Title = "73N TSID " & WSNumOfOpp.Cells(2, 11) & " Top 10"
            .Sheets(1).Name = ATARankTen
            .Worksheets.Add().Name = ATARankNine
            .Worksheets.Add().Name = ATARankEight
            .Worksheets.Add().Name = ATARankSeven
            .Worksheets.Add().Name = ATARankSix
            .Worksheets.Add().Name = ATARankFive
            .Worksheets.Add().Name = ATARankFour
            .Worksheets.Add().Name = ATARankThree
            .Worksheets.Add().Name = ATARankTwo
            .Worksheets.Add().Name = ATARankOne
            .Worksheets.Add().Name = "Top 10"
            '.SaveAs Filename:="Allsales.xls"
        End With
        
        'Top 10 Sheet
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA12").Copy
        NewBook.Sheets("Top 10").Paste Destination:=Sheets("Top 10").Rows(2).Columns(1)
        
        Set NewBookTopTen = NewBook.Sheets("Top 10")
        
        With NewBookTopTen
        
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        .Rows(4).RowHeight = 15
        .Rows(5).RowHeight = 15
        .Rows(6).RowHeight = 15
        .Rows(7).RowHeight = 15
        .Rows(8).RowHeight = 15
        .Rows(9).RowHeight = 15
        .Rows(10).RowHeight = 15
        .Rows(11).RowHeight = 15
        .Rows(12).RowHeight = 15
        .Rows(13).RowHeight = 15
        
        End With
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 1
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy
        NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankOne)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankOne
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    '===============================================================================================================================
    '===============================================================================================================================

    From ATA Rank 1 everything is the same till ATA Rank 10 (except destination sheet)

    'ATA Rank 10
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C12:AA12").Copy
        NewBook.Sheets(ATARankTen).Paste Destination:=Sheets(ATARankTen).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankTen)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankTen
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    
        
    End Sub
    

    I hope someone can help...

    Thanks in advance!


    Wednesday, November 2, 2016 5:57 PM

Answers

  • Hi,

    You could use UsedRange.Columns(index)  or UsedRange.Columns("A:B").Select to select or omit the columns

    I suggest you use something like:

    Dim rng As Range
    Set rng = Union(ActiveSheet.UsedRange.Columns("A:R"), ActiveSheet.UsedRange.Columns("V"))
    rng.Select

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by ganeshgebhard Tuesday, November 8, 2016 10:34 AM
    Tuesday, November 8, 2016 3:05 AM
    Moderator

All replies

  • Hi,

    I have to build a Excel file every month, with 11 sheets which contains data. When I do this by hand, the file size is about 1,000 KB (with all the sheets and data).

    Now I wanted to let Excel build this file for me, which would save me 8 hours of work. Only when I do this, the file-size after sheet number 4 is more than 200,000 KB... With this, Excel can not complete the task due to memory problems.

    Is there a way to solve this?

    The code:

    Sub DataSheet()
    
    Dim ShapePP As Object
    Dim rSource As Range
    
        'Defining Names
        Set WB = ThisWorkbook
        Set WSIndex = WB.Worksheets(1)
        Set WSDelay = WB.Worksheets(3)
        Set WSNumOfOpp = WB.Worksheets(6)
        Set WSCompl = WB.Worksheets(5)
        Set WSUGT = WB.Worksheets(4)
        Set NewBook = Workbooks.Add
        
        'Defining ATA-names
        ATARankOne = WSIndex.Cells(3, 5)
        ATARankTwo = WSIndex.Cells(4, 5)
        ATARankThree = WSIndex.Cells(5, 5)
        ATARankFour = WSIndex.Cells(6, 5)
        ATARankFive = WSIndex.Cells(7, 5)
        ATARankSix = WSIndex.Cells(8, 5)
        ATARankSeven = WSIndex.Cells(9, 5)
        ATARankEight = WSIndex.Cells(10, 5)
        ATARankNine = WSIndex.Cells(11, 5)
        ATARankTen = WSIndex.Cells(12, 5)
        
    'Create new workbook and add sheets with specific names (the names of the Top 10 ranking).
    'Sheet 1, 2 and 3 are already addded, so these I have to use.
    
        With NewBook
            .Title = "73N TSID " & WSNumOfOpp.Cells(2, 11) & " Top 10"
            .Sheets(1).Name = ATARankTen
            .Worksheets.Add().Name = ATARankNine
            .Worksheets.Add().Name = ATARankEight
            .Worksheets.Add().Name = ATARankSeven
            .Worksheets.Add().Name = ATARankSix
            .Worksheets.Add().Name = ATARankFive
            .Worksheets.Add().Name = ATARankFour
            .Worksheets.Add().Name = ATARankThree
            .Worksheets.Add().Name = ATARankTwo
            .Worksheets.Add().Name = ATARankOne
            .Worksheets.Add().Name = "Top 10"
            '.SaveAs Filename:="Allsales.xls"
        End With
        
        'Top 10 Sheet
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA12").Copy
        NewBook.Sheets("Top 10").Paste Destination:=Sheets("Top 10").Rows(2).Columns(1)
        
        Set NewBookTopTen = NewBook.Sheets("Top 10")
        
        With NewBookTopTen
        
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        .Rows(4).RowHeight = 15
        .Rows(5).RowHeight = 15
        .Rows(6).RowHeight = 15
        .Rows(7).RowHeight = 15
        .Rows(8).RowHeight = 15
        .Rows(9).RowHeight = 15
        .Rows(10).RowHeight = 15
        .Rows(11).RowHeight = 15
        .Rows(12).RowHeight = 15
        .Rows(13).RowHeight = 15
        
        End With
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 1
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy
        NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankOne)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankOne
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 2
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C4:AA4").Copy
        NewBook.Sheets(ATARankTwo).Paste Destination:=Sheets(ATARankTwo).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankTwo)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTwo
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTwo
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankTwo
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
    
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 3
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C5:AA5").Copy
        NewBook.Sheets(ATARankThree).Paste Destination:=Sheets(ATARankThree).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankThree)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankThree
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankThree
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankThree
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 4
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C6:AA6").Copy
        NewBook.Sheets(ATARankFour).Paste Destination:=Sheets(ATARankFour).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankFour)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFour
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFour
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankFour
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 5
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C7:AA7").Copy
        NewBook.Sheets(ATARankFive).Paste Destination:=Sheets(ATARankFive).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankFive)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFive
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFive
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankFive
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 6
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C8:AA8").Copy
        NewBook.Sheets(ATARankSix).Paste Destination:=Sheets(ATARankSix).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankSix)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSix
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSix
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankSix
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 7
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C9:AA9").Copy
        NewBook.Sheets(ATARankSeven).Paste Destination:=Sheets(ATARankSeven).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankSeven)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSeven
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSeven
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankSeven
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 8
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C10:AA10").Copy
        NewBook.Sheets(ATARankEight).Paste Destination:=Sheets(ATARankEight).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankEight)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankEight
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankEight
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankEight
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 9
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C11:AA11").Copy
        NewBook.Sheets(ATARankNine).Paste Destination:=Sheets(ATARankNine).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankNine)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankNine
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankNine
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankNine
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 10
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C12:AA12").Copy
        NewBook.Sheets(ATARankTen).Paste Destination:=Sheets(ATARankTen).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankTen)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankTen
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    
        
    End Sub
    
    
    Thanks in advance!


    Wednesday, November 2, 2016 5:47 PM
  • Hi,

    I have to build a Excel file every month, with 11 sheets which contains data. When I do this by hand, the file size is about 1,000 KB (with all the sheets and data).

    Now I wanted to let Excel build this file for me, which would save me 8 hours of work. Only when I do this, the file-size after sheet number 4 is more than 200,000 KB... With this, Excel can not complete the task due to memory problems.

    Is there a way to solve this?

    The code:

    Sub DataSheet()
    
    Dim ShapePP As Object
    Dim rSource As Range
    
        'Defining Names
        Set WB = ThisWorkbook
        Set WSIndex = WB.Worksheets(1)
        Set WSDelay = WB.Worksheets(3)
        Set WSNumOfOpp = WB.Worksheets(6)
        Set WSCompl = WB.Worksheets(5)
        Set WSUGT = WB.Worksheets(4)
        Set NewBook = Workbooks.Add
        
        'Defining ATA-names
        ATARankOne = WSIndex.Cells(3, 5)
        ATARankTwo = WSIndex.Cells(4, 5)
        ATARankThree = WSIndex.Cells(5, 5)
        ATARankFour = WSIndex.Cells(6, 5)
        ATARankFive = WSIndex.Cells(7, 5)
        ATARankSix = WSIndex.Cells(8, 5)
        ATARankSeven = WSIndex.Cells(9, 5)
        ATARankEight = WSIndex.Cells(10, 5)
        ATARankNine = WSIndex.Cells(11, 5)
        ATARankTen = WSIndex.Cells(12, 5)
        
    'Create new workbook and add sheets with specific names (the names of the Top 10 ranking).
    'Sheet 1, 2 and 3 are already addded, so these I have to use.
    
        With NewBook
            .Title = "73N TSID " & WSNumOfOpp.Cells(2, 11) & " Top 10"
            .Sheets(1).Name = ATARankTen
            .Worksheets.Add().Name = ATARankNine
            .Worksheets.Add().Name = ATARankEight
            .Worksheets.Add().Name = ATARankSeven
            .Worksheets.Add().Name = ATARankSix
            .Worksheets.Add().Name = ATARankFive
            .Worksheets.Add().Name = ATARankFour
            .Worksheets.Add().Name = ATARankThree
            .Worksheets.Add().Name = ATARankTwo
            .Worksheets.Add().Name = ATARankOne
            .Worksheets.Add().Name = "Top 10"
            '.SaveAs Filename:="Allsales.xls"
        End With
        
        'Top 10 Sheet
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA12").Copy
        NewBook.Sheets("Top 10").Paste Destination:=Sheets("Top 10").Rows(2).Columns(1)
        
        Set NewBookTopTen = NewBook.Sheets("Top 10")
        
        With NewBookTopTen
        
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        .Rows(4).RowHeight = 15
        .Rows(5).RowHeight = 15
        .Rows(6).RowHeight = 15
        .Rows(7).RowHeight = 15
        .Rows(8).RowHeight = 15
        .Rows(9).RowHeight = 15
        .Rows(10).RowHeight = 15
        .Rows(11).RowHeight = 15
        .Rows(12).RowHeight = 15
        .Rows(13).RowHeight = 15
        
        End With
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 1
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy
        NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankOne)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankOne
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankOne
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 2
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C4:AA4").Copy
        NewBook.Sheets(ATARankTwo).Paste Destination:=Sheets(ATARankTwo).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankTwo)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTwo
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTwo
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankTwo
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTwo).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
    
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 3
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C5:AA5").Copy
        NewBook.Sheets(ATARankThree).Paste Destination:=Sheets(ATARankThree).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankThree)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankThree
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankThree
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankThree
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankThree).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 4
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C6:AA6").Copy
        NewBook.Sheets(ATARankFour).Paste Destination:=Sheets(ATARankFour).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankFour)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFour
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFour
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankFour
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFour).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 5
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C7:AA7").Copy
        NewBook.Sheets(ATARankFive).Paste Destination:=Sheets(ATARankFive).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankFive)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFive
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankFive
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankFive
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankFive).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 6
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C8:AA8").Copy
        NewBook.Sheets(ATARankSix).Paste Destination:=Sheets(ATARankSix).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankSix)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSix
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSix
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankSix
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSix).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 7
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C9:AA9").Copy
        NewBook.Sheets(ATARankSeven).Paste Destination:=Sheets(ATARankSeven).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankSeven)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSeven
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankSeven
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankSeven
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankSeven).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 8
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C10:AA10").Copy
        NewBook.Sheets(ATARankEight).Paste Destination:=Sheets(ATARankEight).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankEight)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankEight
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankEight
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankEight
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankEight).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 9
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C11:AA11").Copy
        NewBook.Sheets(ATARankNine).Paste Destination:=Sheets(ATARankNine).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankNine)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankNine
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankNine
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankNine
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankNine).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
    
    '===============================================================================================================================
    '===============================================================================================================================
        'ATA Rank 10
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C12:AA12").Copy
        NewBook.Sheets(ATARankTen).Paste Destination:=Sheets(ATARankTen).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankTen)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSDelay.Range("A:W").AutoFilter Field:=13, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:W7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=23
        WSDelay.Range("A:W").AutoFilter Field:=17
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:W").AutoFilter Field:=17, Criteria1:=ATARankTen
        WSUGT.Range("A:W").AutoFilter Field:=15, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,W:W").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:W40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=23
        WSUGT.Range("A:W").AutoFilter Field:=17
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:R").AutoFilter Field:=18, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:R").AutoFilter Field:=17, Criteria1:=ATARankTen
        
        'Copy and paste the filtered data
        WSCompl.Range("A:R").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankTen).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:W64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=18
        WSCompl.Range("A:R").AutoFilter Field:=17
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0
        
    
        
    End Sub
    
    
    Thanks in advance!


    Wednesday, November 2, 2016 5:49 PM
  • Try to establish which part of the code is causing the problem by saving copies of the workbook after each section of code. The code example below for saving copies of the workbook.

    You will need to add code to save the workbook normally before applying the SaveAsCopy. This should only need to be done once just after creating the new workbook. (If not initially saved normally the workbook will not have a FullName to extract and the SaveAsCopy code will fail).

    You should then be able to identify which section of the code is causing the bloating and then it might be possible to modify the code.

    'Remove the workbook name extension (Edit if not xlsm type workbook)
    'NOTE: FullName includes the path
    strWbName = Replace(WB.FullName, ".xlsm", "")

    'Add a numeric value to the workbook name
    strWbName = strWbName & "_1"        'Increment 1 for each position in the code where a copy is saved

    'Save the copy (Append the required extension and edit xlsm if required)
    WB.SaveCopyAs strWbName & ".xlsm"


    Regards, OssieMac

    Wednesday, November 2, 2016 11:53 PM
  • I did what you suggested and I found out where the problem is, but I don't know how to solve it.

    The code everything goes wrong:

    'ATA Rank 1
        ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy
        NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1)
        
        'Sheet layout
        Set NewBookRankOne = NewBook.Sheets(ATARankOne)
        
        With NewBookRankOne
        .Cells(1, 1).Value = "Top 10 TSID " & WSNumOfOpp.Cells(2, 11)
        .Cells(1, 1).Font.Bold = True
        
        'Columns
        .Columns("A").ColumnWidth = 9
        .Columns("B").ColumnWidth = 9
        .Columns("C").ColumnWidth = 9
        .Columns("D").ColumnWidth = 30
        .Columns("O").ColumnWidth = 14
        .Columns("M").ColumnWidth = 14
        .Columns("W").ColumnWidth = 12
        .Columns("V").ColumnWidth = 14
        .Range("D2:D13").WrapText = True
        'Rows
        .Rows(1).RowHeight = 15
        .Rows(2).RowHeight = 15
        .Rows(3).RowHeight = 15
        
        End With
        
        'Dly and Clx
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSDelay.Range("A:X").AutoFilter Field:=24, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSDelay.Range("A:X").AutoFilter Field:=18, Criteria1:=ATARankOne
        WSDelay.Range("A:X").AutoFilter Field:=14, Criteria1:="Y"
        
        'Copy and paste the filtered data
        WSDelay.Range("A:X").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(7).Columns(1)
        NewBookRankOne.Rows(7).Font.Bold = True
        NewBookRankOne.Range("A7:X7").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A7:X7").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A7:X7").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A7:X7").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSDelay.Range("A:X").AutoFilter Field:=24
        WSDelay.Range("A:X").AutoFilter Field:=18
        WSDelay.Range("A:X").AutoFilter Field:=14
    '-------------------------------------------------------------------------------------------------------------------------
        'UGT
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        'Filter Sheet (TSID Delay Data)
        WSUGT.Range("A:V").AutoFilter Field:=22, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSUGT.Range("A:V").AutoFilter Field:=16, Criteria1:=ATARankOne
        WSUGT.Range("A:V").AutoFilter Field:=14, Criteria1:="Y"
        
        
        'Copy and paste the filtered data
        WSUGT.Range("A:R,V:V").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(40).Columns(1)
        NewBookRankOne.Rows(40).Font.Bold = True
        NewBookRankOne.Range("A40:S40").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A40:S40").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A40:S40").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A40:S40").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSUGT.Range("A:W").AutoFilter Field:=22
        WSUGT.Range("A:W").AutoFilter Field:=16
        WSUGT.Range("A:W").AutoFilter Field:=14
        
    '----------------------------------------------------------------------------------------------------------------------------
       'Complaints
        'Look for the last & first date
        FirstDate = WSNumOfOpp.Cells(3, 8)
        LastDate = WSNumOfOpp.Cells(3, 9)
        
        'Filter Sheet (TSID Delay Data)
        WSCompl.Range("A:S").AutoFilter Field:=19, Criteria1:=">=" & FirstDate, Operator:=xlAnd, Criteria2:="<=" & LastDate
        WSCompl.Range("A:S").AutoFilter Field:=18, Criteria1:=ATARankOne
        
        'Copy and paste the filtered data
        WSCompl.Range("A:S").SpecialCells(xlCellTypeVisible).Copy Destination:=NewBook.Sheets(ATARankOne).Rows(64).Columns(1)
        NewBookRankOne.Range("A:W").WrapText = False
        NewBookRankOne.Rows(64).Font.Bold = True
        NewBookRankOne.Range("A64:S64").Borders(xlEdgeBottom).Weight = xlMedium
        NewBookRankOne.Range("A64:S64").Borders(xlEdgeTop).Weight = xlMedium
        NewBookRankOne.Range("A64:S64").Borders(xlEdgeLeft).Weight = xlMedium
        NewBookRankOne.Range("A64:S64").Borders(xlEdgeRight).Weight = xlMedium
        
        'Delete the filter
        WSCompl.Range("A:R").AutoFilter Field:=19
        WSCompl.Range("A:R").AutoFilter Field:=18
        
        'All cells blank and no Wrapping
        NewBookRankOne.Range("A:Z").WrapText = False
        NewBookRankOne.Range("A:Z").Interior.ColorIndex = 0

    The first sheet was only 21 KB, but with the second sheet added, this increased to 68,000 KB. The same code is used 10 times, to that is the reason the file becomes this big.

    How can I build this more efficient?

    Thursday, November 3, 2016 9:23 AM
  • I have not tested but the following code does not look correct to me.

    ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy
        NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1)

    I believe that it should be like the following. Note the space and underscore at the end of the first line which is actually a line break in an otherwise single line of code.

    ThisWorkbook.Worksheets("73N Index").Range("C1:AA2,C3:AA3").Copy _
        Destination:=NewBook.Sheets(ATARankOne).Cells(2, 1)

    I also do not understand why the range to be copied is split into two ranges. I would actually code as follows.

    ThisWorkbook.Worksheets("73N Index").Range("C1:AA3").Copy _
            Destination:=NewBook.Sheets(ATARankOne).Cells(2, 1)

    You have similar code at various places so try editing each place.


    Regards, OssieMac


    • Edited by OssieMac Thursday, November 3, 2016 11:19 AM
    Thursday, November 3, 2016 11:18 AM
  • I implemented the first change you suggested. The size remains 68,000 KB, so that did not solve the problem.

    For the second change suggestion: The two ranges need to be split for several reason, so if I change that, the result would lead to new codes to get the right result back.

    Thanks anyway!

    Thursday, November 3, 2016 12:58 PM
  • The two ranges need to be split for several reason, so if I change that, the result would lead to new codes to get the right result back.

    I really do not understand but I am always willing to learn. Perhaps you would like to explain what occurs if not split into two ranges.

    However, irrespective of above, when you are copying and pasting, are there any formulas in the range that finish up referencing back to the original source? This is something that usually needs to be addressed with Find and Replace to remove the original workbook reference from the formulas.


    Regards, OssieMac

    Thursday, November 3, 2016 8:49 PM
  • No problem.

    Take this image as an example.

    As you can see, case 1 is easy when I'm using the ranges. Case 2 is not, because I don't want that the row with "Test" is visible. When I do not split the ranges, the "Test"-row still occurs. I hope this makes sense to you.

    For the second question: there are a lot of Excel references and formulas in the original file, but when I look to the produced file, the references and formulas are gone and there are only numbers in the cells. Maybe I have to do a special kind of pasting?

    Friday, November 4, 2016 8:30 AM
  • For the second question: there are a lot of Excel references and formulas in the original file, but when I look to the produced file, the references and formulas are gone and there are only numbers in the cells. Maybe I have to do a special kind of pasting?

    I understand the first part now. However, your example that I copied in my question was consecutive rows.

    When copying non consecutive rows and pasting to a new location then the values get pasted rather than formulas. If you want the formulas then use Past Special -> Formulas. However, the formulas will be messed up due to the rows being moved in relation to each other and therefore might not work and that is the reason for the values being pasted by default.

    I think that the best way to achieve your end result is to manually build your destination file and use it as a template and simply open it and use "Save As" to create a new file and then just copy the required constant information to it (formulas should not need to be copied). From your first post I am assuming that you already have an example file that you have built so you should be able to use it as a starting point. You can still use VBA to open the template and "Save As" to a new file name and then copy the required data to it.


    Regards, OssieMac

    Friday, November 4, 2016 10:50 PM
  • Hi,

    Testing part of your code for the 'ATA Rank 10 without COPY and PASTE, the generated file is in normal size.

    I think the issue causes from Range("A:W").SpecialCells(xlCellTypeVisible)

    If you manually paste, you select the range with data, however, using Range("A:W").SpecialCells(xlCellTypeVisible).Copy, it selects the whole range in visible.

    Normally, we use xlCellTypeVisible to get filtered data in a ListObjects(Table)

    For your case, I suggest you use UsedRange.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, November 7, 2016 8:45 AM
    Moderator
  • Nope, didn't work. The file with only the code for the first and second sheet is 70,000 KB..

    I checked to find the problem and it turned out that the file is this big because something that's standing in the UGT part. I think its the Range("A:R,V:V"), but I have no idea how to note that in another way. Columns S, T and U may not be copied with it.

    UPDATE

    I tested my theory and changed Range("A:R,V:V") to UsedRange. The file is now only 161 KB instead of 70,000 KB.

    So now my problem is: is there another way to copy the used range, but not columns S, T and U?


    Monday, November 7, 2016 9:34 AM
  • Hi,

    You could use UsedRange.Columns(index)  or UsedRange.Columns("A:B").Select to select or omit the columns

    I suggest you use something like:

    Dim rng As Range
    Set rng = Union(ActiveSheet.UsedRange.Columns("A:R"), ActiveSheet.UsedRange.Columns("V"))
    rng.Select

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by ganeshgebhard Tuesday, November 8, 2016 10:34 AM
    Tuesday, November 8, 2016 3:05 AM
    Moderator