Changing Range Selection

Belair58

Belair58

Board Regular
Joined
Mar 31, 2005
Messages
95
Hello,

I have a current loop that adds in a SUM in column I (sourceCol) and then highlights columns A:G, copies those cells. It then pastes those cells in the row below it.

From above sourceCol = 8

VBA Code: 
For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               Cells(currentRow, sourceCol).Offset(0, 1).Select
               ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
               'Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Copy
               ActiveCell.PasteSpecial (xlPasteValues)
               
               Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select
               Selection.Copy
               Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
              
           End If
       Next

I now need to copy not only A:G, but also T:W and then paste in the row below it.

How do I modify Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select to include the Range T:W?

I tried
VBA Code: 
Range(ActiveCell.Offset(1, 0):ActiveCell.Offset(1, 6),ActiveCell.Offset(1,11):ActiveCell.Offset(1,14)).Select

Any help would be greatly appreciated
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
Well I may be able to help but when writing code it is never a good ideal to use active cell.

Why not explain in detail what your wanting a script to do for you.
 
Upvote 0
My Answer,

Thanks for your reply. Here's the entire macro. As you can see it's very large and unwieldy. I was hoping to just get an idea of how to edit the one line to increase the range.

VBA Code: 
Sub Gross_Dollars_Arthur()
'Sub Auto_Open_Not_Yet()
'Sub Auto_Open()
'Sub Everything_09202019_Add_SubTotals_Product_Code_Active_Sheet_Wendy()

Application.DisplayAlerts = False

'*********************** Open Txt File  *********************

ChDir "O:\k_s\config\excel"
    Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt" _
        , Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=False, Space:=False, Other:=True, OtherChar:="$", FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'*********************** End of Opening File *******************

Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\Arthur\Test_Arthur_ALL_Output_With_Status.txt", Origin:=437 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="$", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1)), _
        TrailingMinusNumbers:=True

'**********  Move Salesman to the end ***************************

Columns("P:S").Select
    Selection.Cut
    Columns("X:AA").Select
    Selection.Insert Shift:=xlToRight
        
        
        
'Added to remove multiple Manager Review Steps

Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=1, Criteria1:="Finished"
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=15, Criteria1:="0"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
  ' *********************************** added to unfilter rows ***************************
    Cells.Select
    Selection.AutoFilter
'**************************    Remove Blank Lines ***************
ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort
        .SetRange Range("A1:X1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' End of Addition

'*******************************  Duplicates  *********************
'Removing Duplicates ***************************************************


    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row
    Dim rng As Range
    'Dim FirstRange As Excel.Range
    Dim sourceCol As Integer, sourceCol2 As Integer, rowCount As Integer, currentRow As Integer
    Dim currentRowValue As String
    
        sourceCol = 8   'column F has a value of 6
        sourceCol2 = 20  ' Added to give the ability to copy T thru W easily
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
        
        ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)

    For iCntr = 1 To lastRow
    If Cells(iCntr, 2) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 25) = "Duplicate"
       End If
    End If
    
    Next
    
' Second section of the Macro
   
   'Dim rng As Range
    Dim FirstRange As Excel.Range
    
    ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)
   
   Do While Not rng Is Nothing
        
      ' If this is the first find then store the range
      ' as .Find will loop continuously
      If FirstRange Is Nothing Then
         Set FirstRange = rng
      Else
         ' Not the first find so check if it's looping around
         ' the occurrances. If the found range address is the same
         ' as the first find, then time to get out.
         If rng.Address = FirstRange.Address Then
            Exit Do
         End If
      End If
      
      ' Count the number of blanks cells in the row below, if equal to the
      ' number of columns then the row is blank and should be ignored. If not equal
      ' then add a row
      If WorksheetFunction.CountBlank(rng.Offset(1).EntireRow) <> Columns.Count Then
         
         rng.Offset(1).EntireRow.Insert
      
      End If
      
      ' Go find the next occurrance starting from the last found
      Set rng = ActiveSheet.Cells.FindNext(After:=rng.Cells(1))
      
   Loop
   ' End of the second section
    
   ' Start of the third Macro
   
    'for every row, find the first blank cell and select it
       For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               Cells(currentRow, sourceCol).Offset(0, 1).Select
               ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
               'Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Copy
               ActiveCell.PasteSpecial (xlPasteValues)
               
             '  Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select
               Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select
               'Selection.Copy
               Selection.Copy
               Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               'Range("ActiveCell.Offset(1, 0):ActiveCell.Offset(1, 6), ActiveCell.Offset(1,11):ActiveCell.Offset(1,14)").Select
               'Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
               Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
    ' Copy/Paste second section.
               
               
               
               'Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(8, -1)).Select
               'Selection.Copy
               'Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               'Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
               
           End If
       Next
      For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Offset(-1, 2).Range("A1:F1").Select
       Selection.Copy
       ActiveCell.Offset(1, 0).Range("A1:F1").Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
       
 'Added to
       
       
               
                          
           End If
    Next
    

    
    
    
    
    'End of the third section
    
    ' Start of the fourth section
    
    For currentRow = 1 To rowCount
            currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Or currentRowValue = "" Then
                Cells(currentRow, sourceCol).Select
                'Cells(currentRow, sourceCol).Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = _
            "=ROUND(SUM((RC[-3]-(RC[1]+RC[3]+RC[4]))/RC[-3])*100,2)"
            ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Paste
        ActiveCell.Offset(-2, 0).Rows("1:2").EntireRow.Select
        Selection.Delete Shift:=xlUp
   
    End If
    Next
    
 ' Start of the fifth section for Gross Margin Dollars
 '' Removed as I'm getting the total from teh query now instead of doing it in Excel
 
 ''   Range("X2").Select
    
 ''   For Each cell In Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row)
 ''  If Not IsEmpty(cell) Then
 ''                  ActiveCell.Offset(0, 0).FormulaR1C1 = _
 ''           "=SUM((RC[-19])-(RC[-15]+RC[-13]+RC[-12]))"
 ''                  ActiveCell.Offset(1, 0).Select
                   
   
 ''   End If
 ''   Next

' ****************************** Duplicates ***********************
Cells.Select
ActiveSheet.Select
Set shtJT = ActiveWorkbook.ActiveSheet
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:X1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:X1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:= _
        "=IN AWN 1", Operator:=xlOr, Criteria2:="=IN AWN 2"
    ActiveWindow.SmallScroll Down:=-30
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "IN AWN"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN CL 1", "IN CL 2", "IN CL 3", "INREVCL1", "INREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "IN Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-160
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SIGN 1", "IN SIGN 2", "IN SIGN 3"), Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "IN Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-70
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:= _
        "=NC AWN 1", Operator:=xlOr, Criteria2:="=NC AWN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "NC AWN"
    Sheets("NC AWN").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "NC CL 1", "NC CL 2", "NC CL 3", "NCREVCL1", "NCREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "NC Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:= _
    "=NC SIGN 1", Operator:=xlOr, Criteria2:="=NC SIGN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "NC Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NC Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
' Added for Vista / SlimBrite / FaceOnly


   ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SB 2", "IN SB 3", "IN FACE ONLY", "VIST", "IN FACE ONLY WARRANTY", "IN SB WARRANTY", "IN VISTA WARRANTY", "NC FACE ONLY"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "VIST-FO-SB"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("VIST-FO-SB").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
' End of Addition
    
    Rows("1:1").Select
    Selection.Copy
    Sheets("NC Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("NC AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Application.CutCopyMode = False
    
    
    
' Added to run through the sheets and add the percentages for the entire reporting cycle of each department.
    
    
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
ws.Activate
Set shtJT = ws


' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank



Range("O2").Select

' ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))"
' Changed to show current as
'ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",RC[-1]<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",RC[-1]>RC[-2]), ""Working"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"
ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",TODAY()<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",TODAY()<RC[-2]), ""LATE"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"


Range("O2").Select
With shtJT

'Added to fix the one record issue ***************************************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip
' End of fix
.Range("O2").AutoFill .Range("O2:O" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Skip:
End With
shtJT.Select
Columns("A:X").Select
shtJT.Sort.SortFields. _
Clear
shtJT.Sort.SortFields. _
Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
shtJT.Sort.SortFields. _
Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With shtJT.Sort
.SetRange Range("A1:X1000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
'End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "On-Time?"

Range("P1").Value = "Late"
Range("Q1").Value = "Incorrect"
Range("R1").Value = "Pending"
Range("S1").Value = "On-Time"
Range("T1").Value = "Total Pecentage"
Range("V1").Value = "Gross Margin Dollars"


ActiveSheet.Select
Range("O65536").End(xlUp).Cells(2, 1).Select
'ActiveCell.Offset(rowOffset:=0, columnOffset:=15).Activate
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
'ActiveSheet.Paste
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Late"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Incorrect"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Pending"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""On-Time"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
'Next ws
End With

Columns("A:T").Select
Columns("A:T").EntireColumn.AutoFit
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True

' Added to remove empty cells **************************************************************************************************************

ActiveSheet.UsedRange

'Dim sourceCol1 As Integer, rowCount1 As Integer, currentRow1 As Integer
'    Dim currentRowValue1 As String
'
'    sourceCol1 = 1   'column F has a value of 6
'    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
'    For currentRow1 = 1 To rowCount1
'        currentRowValue1 = Cells(currentRow1, sourceCol1).Value
'        If IsEmpty(currentRowValue1) Or currentRowValue1 = "" Then
'            Cells(currentRow1, sourceCol1).Select
'        End If
'    Next
    



' Added to sub Total each sheet by Cycle Code



Columns("A:X").Select
    Selection.Subtotal GroupBy:=10, Function:=xlCount, TotalList:=Array(10), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
        
 Dim myLastRow As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    
'   Find last row
    myLastRow = Cells(Rows.Count, "I").End(xlUp).Row
    
'   Loop through range
   For i = 2 To myLastRow
        If Cells(i, "I").Value Like "****Count" Then Range(Cells(i, "I"), Cells(i, "J")).ClearContents
    Next i
        
    Application.ScreenUpdating = True
    ActiveSheet.Range("$A$1:$X$1000").AutoFilter Field:=4
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.RemoveSubtotal
    
' *********************** Add Percentages by each Cycle Code ****************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip2
    Dim c As Range
  For Each c In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    c.Cells(c.Rows.Count, 1).Offset(1, 1).Formula = "=ROUND(COUNTIF(" & c.Address(1, 1) & ",""Late"")/COUNTA(" & c.Address(1, 1) & ")*100,2)"
  Next

Dim d As Range
  For Each d In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    d.Cells(d.Rows.Count, 1).Offset(1, 2).Formula = "=ROUND(COUNTIF(" & d.Address(1, 2) & ",""INCORRECT"")/COUNTA(" & d.Address(1, 1) & ")*100,2)"
  Next
  
  Dim e As Range
  For Each e In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    e.Cells(e.Rows.Count, 1).Offset(1, 3).Formula = "=ROUND(COUNTIF(" & e.Address(1, 3) & ",""Pending"")/COUNTA(" & e.Address(1, 1) & ")*100,2)"
  Next
  
  Dim f As Range
  For Each f In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    f.Cells(f.Rows.Count, 1).Offset(1, 4).Formula = "=ROUND(COUNTIF(" & f.Address(1, 4) & ",""On-Time"")/COUNTA(" & f.Address(1, 1) & ")*100,2)"
  Next

  '****************************** Add totals to Column E **************************

  Dim g As Range
  For Each g In Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ":" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Formula = "=SUM(" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Style = "Currency"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Style = "Currency"
  Next
  '***************************** Add Total Gross Margin Dollars *****************************************
Dim v As Range
  For Each v In Range("V2:V" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ":" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ")"
    v.Cells(v.Rows.Count, 1).Offset(1, 0).Formula = "=SUM(" & v.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Formula = "=SUM(" & g.Address(1, 1) & ")"
    v.Cells(v.Rows.Count, 1).Offset(1, 0).Style = "Currency"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Style = "Currency"
  Next
  
  
  
  
Skip2:
  
   '***************************** End of Totals in Column E ************************

  
Selection.AutoFilter

'Added to delete blank sheets, no jobs in cetegory ************************************************************
'Will need to insert code to have macro work with zero records and only one record ****************************
Blank:


Next ws


' Add Engineering Column ***********************************************************

Dim wse As Worksheet
For Each wse In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
wse.Activate
Set shtJT = wse



' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank2
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank2
' End of blank sheets

Range("T" & Cells.Rows.Count).End(xlUp).Select
    ActiveCell.Offset(-1, 1).Select

    ActiveCell.FormulaR1C1 = _
        "=IFNA(VLOOKUP(R[0]C[-19], File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt!C1:C2, 2, FALSE),"""")"
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(-1, 0).Select
    
    Range(Selection, Selection.End(xlUp)).Select
   
    ActiveSheet.Paste
    Range("U1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Engineer"
    Columns("U:U").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Blank2:

Next wse


'**************** adding Gross Margin Sheet **********************

Sheets.Add After:=ActiveSheet
    Sheets("Sheet8").Select
    Sheets("Sheet8").Name = "Gross_Margins"
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    Cells.Select
    Range("D1").Activate
    Selection.Copy
    Sheets("Gross_Margins").Select
    Cells.Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    Columns("W:W").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 16.71
    Cells.Select
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "A2:A155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "K2:K155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "E2:E155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Gross_Margins").Sort
        .SetRange Range("A1:X1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(23), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    Selection.Subtotal GroupBy:=11, Function:=xlSum, TotalList:=Array(23), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
        
'********************** Set Columns to Currency***********************************
Range("J:J,L:L,M:M,W:W,F:F").Select
    
    Selection.NumberFormat = "$#,##0.00"



'************************* Save Files ************************

Application.DisplayAlerts = False
ChDir "O:\k_s\Manager_Reports"
    ActiveWorkbook.SaveAs Filename:= _
        "O:\k_s\Manager_Reports\Gross_Margins_Arthur_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False


'ChDir "O:\Manager Forms\Manager_Reports"
'    ActiveWorkbook.SaveAs Filename:= _
'        "O:\Manager Forms\Manager_Reports\Arthur_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
'        xlOpenXMLWorkbook, CreateBackup:=False
       
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True


'Application.Quit

    
    

End Sub

Sub Formula_For_Sum()
'
' Formula_For_Sum Macro
'

'
    Windows("Test_Arthur_ALL_Output_With_Status.txt").Activate
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "=SUM((RC[-16])-(RC[-12]+RC[-10]+RC[-9]))"
    Range("U3").Select
    Windows("Gross_Margin_Dollars.xlsm").Activate
End Sub

'Sub Auto_Open_Not_Yet()
Sub Back_Up_Working_Auto_Open()
'Sub Everything_09202019_Add_SubTotals_Product_Code_Active_Sheet_Wendy()

Application.DisplayAlerts = False

'*********************** Open Txt File  *********************

ChDir "O:\k_s\config\excel"
    Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt" _
        , Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=False, Space:=False, Other:=True, OtherChar:="$", FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'*********************** End of Opening File *******************

Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\Arthur\Test_Arthur_ALL_Output_With_Status.txt", Origin:=437 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="$", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), _
        TrailingMinusNumbers:=True
        
'Added to remove multiple Manager Review Steps

Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=1, Criteria1:="Finished"
    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=15, Criteria1:="0"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
  ' *********************************** added to unfilter rows ***************************
    Cells.Select
    Selection.AutoFilter
'**************************    Remove Blank Lines ***************
ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Test_Arthur_ALL_Output_With_Sta").Sort
        .SetRange Range("A1:O1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' End of Addition

'*******************************  Duplicates  *********************
'Removing Duplicates ***************************************************


    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row
    Dim rng As Range
    'Dim FirstRange As Excel.Range
    Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
    Dim currentRowValue As String
    
        sourceCol = 8   'column F has a value of 6
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
        
        ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)

    For iCntr = 1 To lastRow
    If Cells(iCntr, 2) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 21) = "Duplicate"
       End If
    End If
    
    Next
    
' Second section of the Macro
   
   'Dim rng As Range
    Dim FirstRange As Excel.Range
    
    ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)
   
   Do While Not rng Is Nothing
        
      ' If this is the first find then store the range
      ' as .Find will loop continuously
      If FirstRange Is Nothing Then
         Set FirstRange = rng
      Else
         ' Not the first find so check if it's looping around
         ' the occurrances. If the found range address is the same
         ' as the first find, then time to get out.
         If rng.Address = FirstRange.Address Then
            Exit Do
         End If
      End If
      
      ' Count the number of blanks cells in the row below, if equal to the
      ' number of columns then the row is blank and should be ignored. If not equal
      ' then add a row
      If WorksheetFunction.CountBlank(rng.Offset(1).EntireRow) <> Columns.Count Then
         
         rng.Offset(1).EntireRow.Insert
      
      End If
      
      ' Go find the next occurrance starting from the last found
      Set rng = ActiveSheet.Cells.FindNext(After:=rng.Cells(1))
      
   Loop
   ' End of the second section
    
   ' Start of the third Macro
   
    'for every row, find the first blank cell and select it
       For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               Cells(currentRow, sourceCol).Offset(0, 1).Select
               ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
               'Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Copy
               ActiveCell.PasteSpecial (xlPasteValues)
               
               Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select
               Selection.Copy
               Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
    ' Copy/Paste second section.
               
               
               
               'Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(8, -1)).Select
               'Selection.Copy
               'Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               'Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
               
           End If
       Next
      For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Offset(-1, 2).Range("A1:F1").Select
       Selection.Copy
       ActiveCell.Offset(1, 0).Range("A1:F1").Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
               
                          
           End If
    Next
    
    'End of the third section
    
    ' Start of the fourth section
    
    For currentRow = 1 To rowCount
            currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Or currentRowValue = "" Then
                Cells(currentRow, sourceCol).Select
                'Cells(currentRow, sourceCol).Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = _
            "=ROUND(SUM((RC[-3]-(RC[1]+RC[3]+RC[4]))/RC[-3])*100,2)"
            ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Paste
        ActiveCell.Offset(-2, 0).Rows("1:2").EntireRow.Select
        Selection.Delete Shift:=xlUp
   
    End If
    Next


' ****************************** Duplicates ***********************
Cells.Select
ActiveSheet.Select
Set shtJT = ActiveWorkbook.ActiveSheet
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:N1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:N1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:= _
        "=IN AWN 1", Operator:=xlOr, Criteria2:="=IN AWN 2"
    ActiveWindow.SmallScroll Down:=-30
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "IN AWN"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN CL 1", "IN CL 2", "IN CL 3", "INREVCL1", "INREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "IN Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-160
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SIGN 1", "IN SIGN 2", "IN SIGN 3"), Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "IN Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-70
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:= _
        "=NC AWN 1", Operator:=xlOr, Criteria2:="=NC AWN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "NC AWN"
    Sheets("NC AWN").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "NC CL 1", "NC CL 2", "NC CL 3", "NCREVCL1", "NCREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "NC Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:= _
    "=NC SIGN 1", Operator:=xlOr, Criteria2:="=NC SIGN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "NC Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NC Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("Test_Arthur_ALL_Output_With_Sta").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
' Added for Vista / SlimBrite / FaceOnly


   ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SB 2", "IN SB 3", "IN FACE ONLY", "VIST", "IN FACE ONLY WARRANTY", "IN SB WARRANTY", "IN VISTA WARRANTY", "NC FACE ONLY"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "VIST-FO-SB"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("VIST-FO-SB").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
' End of Addition
    
    Rows("1:1").Select
    Selection.Copy
    Sheets("NC Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("NC AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Application.CutCopyMode = False
    
    
    
' Added to run through the sheets and add the percentages for the entire reporting cycle of each department.
    
    
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
ws.Activate
Set shtJT = ws


' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank



Range("O2").Select

' ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))"
' Changed to show current as
'ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",RC[-1]<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",RC[-1]>RC[-2]), ""Working"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"
ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",TODAY()<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",TODAY()<RC[-2]), ""LATE"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"


Range("O2").Select
With shtJT

'Added to fix the one record issue ***************************************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip
' End of fix
.Range("O2").AutoFill .Range("O2:O" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Skip:
End With
shtJT.Select
Columns("A:O").Select
shtJT.Sort.SortFields. _
Clear
shtJT.Sort.SortFields. _
Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
shtJT.Sort.SortFields. _
Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With shtJT.Sort
.SetRange Range("A1:O1000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
'End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "On-Time?"

Range("P1").Value = "Late"
Range("Q1").Value = "Incorrect"
Range("R1").Value = "Pending"
Range("S1").Value = "On-Time"
Range("T1").Value = "Total Pecentage"


ActiveSheet.Select
Range("O65536").End(xlUp).Cells(2, 1).Select
'ActiveCell.Offset(rowOffset:=0, columnOffset:=15).Activate
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
'ActiveSheet.Paste
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Late"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Incorrect"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Pending"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""On-Time"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
'Next ws
End With

Columns("A:T").Select
Columns("A:T").EntireColumn.AutoFit
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True

' Added to remove empty cells **************************************************************************************************************

ActiveSheet.UsedRange

'Dim sourceCol1 As Integer, rowCount1 As Integer, currentRow1 As Integer
'    Dim currentRowValue1 As String
'
'    sourceCol1 = 1   'column F has a value of 6
'    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
'    For currentRow1 = 1 To rowCount1
'        currentRowValue1 = Cells(currentRow1, sourceCol1).Value
'        If IsEmpty(currentRowValue1) Or currentRowValue1 = "" Then
'            Cells(currentRow1, sourceCol1).Select
'        End If
'    Next
    



' Added to sub Total each sheet by Cycle Code



Columns("A:T").Select
    Selection.Subtotal GroupBy:=10, Function:=xlCount, TotalList:=Array(10), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
        
 Dim myLastRow As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    
'   Find last row
    myLastRow = Cells(Rows.Count, "I").End(xlUp).Row
    
'   Loop through range
   For i = 2 To myLastRow
        If Cells(i, "I").Value Like "****Count" Then Range(Cells(i, "I"), Cells(i, "J")).ClearContents
    Next i
        
    Application.ScreenUpdating = True
    ActiveSheet.Range("$A$1:$U$1000").AutoFilter Field:=4
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.RemoveSubtotal
    
' *********************** Add Percentages by each Cycle Code ****************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip2
    Dim c As Range
  For Each c In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    c.Cells(c.Rows.Count, 1).Offset(1, 1).Formula = "=ROUND(COUNTIF(" & c.Address(1, 1) & ",""Late"")/COUNTA(" & c.Address(1, 1) & ")*100,2)"
  Next

Dim d As Range
  For Each d In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    d.Cells(d.Rows.Count, 1).Offset(1, 2).Formula = "=ROUND(COUNTIF(" & d.Address(1, 2) & ",""INCORRECT"")/COUNTA(" & d.Address(1, 1) & ")*100,2)"
  Next
  
  Dim e As Range
  For Each e In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    e.Cells(e.Rows.Count, 1).Offset(1, 3).Formula = "=ROUND(COUNTIF(" & e.Address(1, 3) & ",""Pending"")/COUNTA(" & e.Address(1, 1) & ")*100,2)"
  Next
  
  Dim f As Range
  For Each f In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    f.Cells(f.Rows.Count, 1).Offset(1, 4).Formula = "=ROUND(COUNTIF(" & f.Address(1, 4) & ",""On-Time"")/COUNTA(" & f.Address(1, 1) & ")*100,2)"
  Next

  '****************************** Add totals to Column E **************************

  Dim g As Range
  For Each g In Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ":" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Style = "Currency"
    

    
  Next
Skip2:
  
   '***************************** End of Totals in Column E ************************

  
Selection.AutoFilter

'Added to delete blank sheets, no jobs in cetegory ************************************************************
'Will need to insert code to have macro work with zero records and only one record ****************************
Blank:


Next ws


' Add Engineering Column ***********************************************************

Dim wse As Worksheet
For Each wse In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
wse.Activate
Set shtJT = wse



' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank2
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank2
' End of blank sheets

Range("T" & Cells.Rows.Count).End(xlUp).Select
    ActiveCell.Offset(-1, 1).Select

    ActiveCell.FormulaR1C1 = _
        "=IFNA(VLOOKUP(R[0]C[-19], File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt!C1:C2, 2, FALSE),"""")"
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(-1, 0).Select
    
    Range(Selection, Selection.End(xlUp)).Select
   
    ActiveSheet.Paste
    Range("U1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Engineer"
    Columns("U:U").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Blank2:

Next wse


'************************* Save Files ************************


Application.DisplayAlerts = False
ChDir "O:\k_s\Manager_Reports"
    ActiveWorkbook.SaveAs Filename:= _
        "O:\k_s\Manager_Reports\Arthur_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False


ChDir "O:\Manager Forms\Manager_Reports"
    ActiveWorkbook.SaveAs Filename:= _
        "O:\Manager Forms\Manager_Reports\Arthur_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
       
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True


'Application.Quit

    
    

End Sub

Sub Gross_Dollars_Wendy()
'Sub Auto_Open_Not_Yet()
'Sub Auto_Open()
'Sub Everything_09202019_Add_SubTotals_Product_Code_Active_Sheet_Wendy()

Application.DisplayAlerts = False

'*********************** Open Txt File  *********************

ChDir "O:\k_s\config\excel"
    Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt" _
        , Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=False, Space:=False, Other:=True, OtherChar:="$", FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'*********************** End of Opening File *******************

Workbooks.OpenText Filename:= _
        "O:\k_s\config\excel\Wendy\Test_Wendy_ALL_Output_With_Status.txt", Origin:=437 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="$", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), _
        TrailingMinusNumbers:=True

'**********  Move Salesman to the end ***************************

Columns("P:P").Select
    Selection.Cut
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight
    
        
        
        
'Added to remove multiple Manager Review Steps

Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$1000").AutoFilter Field:=1, Criteria1:="Finished"
    ActiveSheet.Range("$A$1:$P$1000").AutoFilter Field:=15, Criteria1:="0"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
  ' *********************************** added to unfilter rows ***************************
    Cells.Select
    Selection.AutoFilter
'**************************    Remove Blank Lines ***************
ActiveWorkbook.Worksheets("Test_Wendy_ALL_Output_With_Stat").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Test_Wendy_ALL_Output_With_Stat").Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Test_Wendy_ALL_Output_With_Stat").Sort
        .SetRange Range("A1:O1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' End of Addition

'*******************************  Duplicates  *********************
'Removing Duplicates ***************************************************


    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row
    Dim rng As Range
    'Dim FirstRange As Excel.Range
    Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
    Dim currentRowValue As String
    
        sourceCol = 8   'column F has a value of 6
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
        
        ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)

    For iCntr = 1 To lastRow
    If Cells(iCntr, 2) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 21) = "Duplicate"
       End If
    End If
    
    Next
    
' Second section of the Macro
   
   'Dim rng As Range
    Dim FirstRange As Excel.Range
    
    ' Find first occurance
    Set rng = ActiveSheet.Cells.Find(What:="Duplicate", MatchCase:=False, LookAt:=xlWhole)
   
   Do While Not rng Is Nothing
        
      ' If this is the first find then store the range
      ' as .Find will loop continuously
      If FirstRange Is Nothing Then
         Set FirstRange = rng
      Else
         ' Not the first find so check if it's looping around
         ' the occurrances. If the found range address is the same
         ' as the first find, then time to get out.
         If rng.Address = FirstRange.Address Then
            Exit Do
         End If
      End If
      
      ' Count the number of blanks cells in the row below, if equal to the
      ' number of columns then the row is blank and should be ignored. If not equal
      ' then add a row
      If WorksheetFunction.CountBlank(rng.Offset(1).EntireRow) <> Columns.Count Then
         
         rng.Offset(1).EntireRow.Insert
      
      End If
      
      ' Go find the next occurrance starting from the last found
      Set rng = ActiveSheet.Cells.FindNext(After:=rng.Cells(1))
      
   Loop
   ' End of the second section
    
   ' Start of the third Macro
   
    'for every row, find the first blank cell and select it
       For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               Cells(currentRow, sourceCol).Offset(0, 1).Select
               ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
               'Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Copy
               ActiveCell.PasteSpecial (xlPasteValues)
               
               Range(ActiveCell.Offset(-1, -8), ActiveCell.Offset(-1, -2)).Select
               Selection.Copy
               Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
    ' Copy/Paste second section.
               
               
               
               'Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(8, -1)).Select
               'Selection.Copy
               'Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 6)).Select
               'Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0)).PasteSpecial xlPasteAll
               
           End If
       Next
      For currentRow = 1 To rowCount
           currentRowValue = Cells(currentRow, sourceCol).Value
           If IsEmpty(currentRowValue) Or currentRowValue = "" Then
               Cells(currentRow, sourceCol).Select
               ActiveCell.Select
               ActiveCell.Offset(-1, 2).Range("A1:F1").Select
       Selection.Copy
       ActiveCell.Offset(1, 0).Range("A1:F1").Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
               
                          
           End If
    Next
    
    'End of the third section
    
    ' Start of the fourth section
    
    For currentRow = 1 To rowCount
            currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Or currentRowValue = "" Then
                Cells(currentRow, sourceCol).Select
                'Cells(currentRow, sourceCol).Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = _
            "=ROUND(SUM((RC[-3]-(RC[1]+RC[3]+RC[4]))/RC[-3])*100,2)"
            ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Paste
        ActiveCell.Offset(-2, 0).Rows("1:2").EntireRow.Select
        Selection.Delete Shift:=xlUp
   
    End If
    Next
    
 ' Start of the fifth section for Gross Margin Dollars
 
    Range("V2").Select
    
    For Each cell In Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row)
    If Not IsEmpty(cell) Then
                   ActiveCell.Offset(0, 0).FormulaR1C1 = _
            "=SUM((RC[-17])-(RC[-13]+RC[-11]+RC[-10]))"
                   ActiveCell.Offset(1, 0).Select
                   
   
    End If
    Next
    
   

' ****************************** Duplicates ***********************
Cells.Select
ActiveSheet.Select
Set shtJT = ActiveWorkbook.ActiveSheet
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:V1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shtJT.Sort.SortFields. _
        Clear
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    shtJT.Sort.SortFields. _
        Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shtJT.Sort
        .SetRange Range("A1:V1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:= _
        "=IN AWN 1", Operator:=xlOr, Criteria2:="=IN AWN 2"
    ActiveWindow.SmallScroll Down:=-30
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "IN AWN"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN CL 1", "IN CL 2", "IN CL 3", "INREVCL1", "INREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "IN Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    ActiveWindow.SmallScroll Down:=-160
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SIGN 1", "IN SIGN 2", "IN SIGN 3"), Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "IN Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    ActiveWindow.SmallScroll Down:=-70
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:= _
        "=NC AWN 1", Operator:=xlOr, Criteria2:="=NC AWN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "NC AWN"
    Sheets("NC AWN").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "NC CL 1", "NC CL 2", "NC CL 3", "NCREVCL1", "NCREVCL2"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "NC Channel Letter"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
    
    ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:= _
    "=NC SIGN 1", Operator:=xlOr, Criteria2:="=NC SIGN 2"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "NC Sign"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NC Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    ActiveWindow.SmallScroll Down:=-60
    Application.CutCopyMode = False
    
' Added for Vista / SlimBrite / FaceOnly


   ActiveSheet.Range("$A$1:$V$1000").AutoFilter Field:=4, Criteria1:=Array( _
        "IN SB 2", "IN SB 3", "IN FACE ONLY", "VIST", "IN FACE ONLY WARRANTY", "IN SB WARRANTY", "IN VISTA WARRANTY", "NC FACE ONLY"), Operator:= _
        xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "VIST-FO-SB"
    Range("A2").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("VIST-FO-SB").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
' End of Addition
    
    Rows("1:1").Select
    Selection.Copy
    Sheets("NC Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("NC AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Sign").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN Channel Letter").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("IN AWN").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Application.CutCopyMode = False
    
    
    
' Added to run through the sheets and add the percentages for the entire reporting cycle of each department.
    
    
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
ws.Activate
Set shtJT = ws


' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank



Range("O2").Select

' ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))"
' Changed to show current as
'ActiveCell.FormulaR1C1 = _
'        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",RC[-1]<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",RC[-1]>RC[-2]), ""Working"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"
ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-14]=""Finished"",RC[-1]<=RC[-2]),""On-Time"",IF(AND(RC[-14]=""Finished"",RC[-1]>RC[-2]),""Late"",IF(AND(RC[-14]=""Pending"",RC[-2]>=TODAY()),""Pending"",IF(AND(RC[-14]=""Pending"",RC[-2]<TODAY()),""Late"",IF(AND(RC[-14]=""CURRENT"",TODAY()<=RC[-2]),""Working"", IF(AND(RC[-14]=""CURRENT"",TODAY()<RC[-2]), ""LATE"", IF(AND(RC[-14]=""""),"""",""INCORRECT"")))))))"


Range("O2").Select
With shtJT

'Added to fix the one record issue ***************************************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip
' End of fix
.Range("O2").AutoFill .Range("O2:O" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Skip:
End With
shtJT.Select
Columns("A:W").Select
shtJT.Sort.SortFields. _
Clear
shtJT.Sort.SortFields. _
Add2 Key:=Range("J2:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
shtJT.Sort.SortFields. _
Add2 Key:=Range("D2:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With shtJT.Sort
.SetRange Range("A1:W1000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
'End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "On-Time?"

Range("P1").Value = "Late"
Range("Q1").Value = "Incorrect"
Range("R1").Value = "Pending"
Range("S1").Value = "On-Time"
Range("T1").Value = "Total Pecentage"
Range("V1").Value = "Gross Margin Dollars"


ActiveSheet.Select
Range("O65536").End(xlUp).Cells(2, 1).Select
'ActiveCell.Offset(rowOffset:=0, columnOffset:=15).Activate
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
'ActiveSheet.Paste
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Late"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Incorrect"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""Pending"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = _
"=ROUND(COUNTIF(R2C15:R1000C15,""On-Time"")/COUNTA(R2C15:R1000C15)*100,2)"
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
'Next ws
End With

Columns("A:T").Select
Columns("A:T").EntireColumn.AutoFit
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True

' Added to remove empty cells **************************************************************************************************************

ActiveSheet.UsedRange

'Dim sourceCol1 As Integer, rowCount1 As Integer, currentRow1 As Integer
'    Dim currentRowValue1 As String
'
'    sourceCol1 = 1   'column F has a value of 6
'    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
'    For currentRow1 = 1 To rowCount1
'        currentRowValue1 = Cells(currentRow1, sourceCol1).Value
'        If IsEmpty(currentRowValue1) Or currentRowValue1 = "" Then
'            Cells(currentRow1, sourceCol1).Select
'        End If
'    Next
    



' Added to sub Total each sheet by Cycle Code



Columns("A:W").Select
    Selection.Subtotal GroupBy:=10, Function:=xlCount, TotalList:=Array(10), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
        
 Dim myLastRow As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    
'   Find last row
    myLastRow = Cells(Rows.Count, "I").End(xlUp).Row
    
'   Loop through range
   For i = 2 To myLastRow
        If Cells(i, "I").Value Like "****Count" Then Range(Cells(i, "I"), Cells(i, "J")).ClearContents
    Next i
        
    Application.ScreenUpdating = True
    ActiveSheet.Range("$A$1:$W$1000").AutoFilter Field:=4
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.RemoveSubtotal
    
' *********************** Add Percentages by each Cycle Code ****************************
If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Skip2
    Dim c As Range
  For Each c In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    c.Cells(c.Rows.Count, 1).Offset(1, 1).Formula = "=ROUND(COUNTIF(" & c.Address(1, 1) & ",""Late"")/COUNTA(" & c.Address(1, 1) & ")*100,2)"
  Next

Dim d As Range
  For Each d In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    d.Cells(d.Rows.Count, 1).Offset(1, 2).Formula = "=ROUND(COUNTIF(" & d.Address(1, 2) & ",""INCORRECT"")/COUNTA(" & d.Address(1, 1) & ")*100,2)"
  Next
  
  Dim e As Range
  For Each e In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    e.Cells(e.Rows.Count, 1).Offset(1, 3).Formula = "=ROUND(COUNTIF(" & e.Address(1, 3) & ",""Pending"")/COUNTA(" & e.Address(1, 1) & ")*100,2)"
  Next
  
  Dim f As Range
  For Each f In Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    f.Cells(f.Rows.Count, 1).Offset(1, 4).Formula = "=ROUND(COUNTIF(" & f.Address(1, 4) & ",""On-Time"")/COUNTA(" & f.Address(1, 1) & ")*100,2)"
  Next

  '****************************** Add totals to Column E **************************

  Dim g As Range
  For Each g In Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ":" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Formula = "=SUM(" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Formula = "=SUM(" & g.Address(1, 1) & ")"
    g.Cells(g.Rows.Count, 1).Offset(1, 0).Style = "Currency"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Style = "Currency"
  Next
  '***************************** Add Total Gross Margin Dollars *****************************************
Dim v As Range
  For Each v In Range("V2:V" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ":" & g.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 1).Formula = "=SUM(" & g.Address(1, 1) & ")"
    v.Cells(v.Rows.Count, 1).Offset(1, 0).Formula = "=SUM(" & v.Address(1, 1) & ")"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Formula = "=SUM(" & g.Address(1, 1) & ")"
    v.Cells(v.Rows.Count, 1).Offset(1, 0).Style = "Currency"
    'g.Cells(g.Rows.Count, 1).Offset(1, 17).Style = "Currency"
  Next
  
  
  
  
Skip2:
  
   '***************************** End of Totals in Column E ************************

  
Selection.AutoFilter

'Added to delete blank sheets, no jobs in cetegory ************************************************************
'Will need to insert code to have macro work with zero records and only one record ****************************
Blank:


Next ws


' Add Engineering Column ***********************************************************

Dim wse As Worksheet
For Each wse In ActiveWorkbook.Worksheets

'Set shtJT = ActiveWorkbook.ActiveSheet
wse.Activate
Set shtJT = wse



' Added to skip blank sheets, no jobs in that category ******************************************************************
If Range("A2").Value = "" Then GoTo Blank2
'If Range("A1", Range("A1").End(xlDown)).Rows.Count = 2 Then GoTo Blank2
' End of blank sheets

Range("T" & Cells.Rows.Count).End(xlUp).Select
    ActiveCell.Offset(-1, 1).Select

    ActiveCell.FormulaR1C1 = _
        "=IFNA(VLOOKUP(R[0]C[-19], File_Daily_Engineering_Dollars_Released_Salesman_Yearly_New.txt!C1:C2, 2, FALSE),"""")"
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(-1, 0).Select
    
    Range(Selection, Selection.End(xlUp)).Select
   
    ActiveSheet.Paste
    Range("U1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Engineer"
    Columns("U:U").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Blank2:

Next wse


'**************** adding Gross Margin Sheet **********************

Sheets.Add After:=ActiveSheet
    Sheets("Sheet8").Select
    Sheets("Sheet8").Name = "Gross_Margins"
    Sheets("Test_Wendy_ALL_Output_With_Stat").Select
    Cells.Select
    Range("D1").Activate
    Selection.Copy
    Sheets("Gross_Margins").Select
    Cells.Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    Columns("W:W").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 16.71
    Cells.Select
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "A2:A155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "K2:K155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Gross_Margins").Sort.SortFields.Add2 Key:=Range( _
        "E2:E155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Gross_Margins").Sort
        .SetRange Range("A1:X1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(23), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    Selection.Subtotal GroupBy:=11, Function:=xlSum, TotalList:=Array(23), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
        
'********************** Set Columns to Currency***********************************
Range("J:J,L:L,M:M,W:W,F:F").Select
    
    Selection.NumberFormat = "$#,##0.00"



'************************* Save Files ************************

Application.DisplayAlerts = False
ChDir "O:\k_s\Manager_Reports"
    ActiveWorkbook.SaveAs Filename:= _
        "O:\k_s\Manager_Reports\Gross_Margins_Wendy_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False


'ChDir "O:\Manager Forms\Manager_Reports"
'    ActiveWorkbook.SaveAs Filename:= _
'        "O:\Manager Forms\Manager_Reports\Arthur_Manager_Report" & Format(Now(), "MM-DD-YYYY hh mm AMPM") & ".xlsx", FileFormat:= _
'        xlOpenXMLWorkbook, CreateBackup:=False
       
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True


'Application.Quit

    
    

End Sub
 
Upvote 0
This is way to much code for me to read and understand.
Maybe someone else here on the forum can help.
Not having any ideal what your attempting to do.
I will keep watching and see if someone else can help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
VBA InputBox without entry quitting Sub/Macro
Replies
1
Views
111
Micron
M
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
184
DanteAmor
DanteAmor
C
  • Solved
With 'Set StrVal=ActiveCell.Address' and ‘Dim StrVal As String’ I get 'Object required' error With ‘Dim StrVal As Range’, a ‘Type Mismatch’ error
Replies
7
Views
162
MARK858
MARK858
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
362
rlv01
R
N
  • Solved
Macro Replicating AutoSum Functionality
Replies
3
Views
91
Joe4
Joe4

Forum statistics

Threads
1,214,907
Messages
6,122,183
Members
449,071
Latest member
cdnMech

Share this page

We've detected that you are using an adblocker.

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

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

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

Disable uBlock

Follow these easy steps to disable uBlock

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