Different results running same macro with same data

MHamid

Active Member
Joined
Jan 31, 2013
Messages
357
Hello,

I think there is something wrong with my code. When I run this same code, i get different results almost every time. Can someone let me know what I am doing wrong?

VBA Code:
Sub open_oc_dec_menu()
'Opens the OC Dec Export form

    'Sheets("report1").visibility = xlSheetVeryHidden
    Sheets("report1").Visible = True
    Sheets("TechReport").Visible = True
    frm_oc_export.Show

End Sub


Sub export_oc_dec()

    app_functions_OFF
    
    'CopyFromPlan2
    fill_with
    highlight_column
    sort_col_L
    name_me2
  
    Insert_Rows
    RunAll
    Formatting
    'Copy_ActiveSheet_New_Workbook
    
    
    app_functions_ON
    
    MsgBox "Complete"
    
End Sub

Sub fill_with()
'Places N/A in columns with no date

Dim last_row As Long
Dim CallIt As String
Dim N As Long

    'Application.Calculation = xlManual
    
    CallIt = "N/A"
    
    last_row = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
    
        'loop for the 1st column
        For i = 2 To last_row
            If Sheets("Report1").Range("D" & i) = "" Then
                Sheets("Report1").Range("D" & i) = CallIt
            End If
        Next
    
        'loop for the 2nd column
        For i = 2 To last_row
            If Sheets("Report1").Range("E" & i) = "" Then
                Sheets("Report1").Range("E" & i) = CallIt
            End If
        Next
        
        N = 1
        
        'adds numbers to column A
            For i = 2 To last_row
            
                Sheets("Report1").Range("A" & i) = N
                N = N + 1
                
            Next
        
    'Application.Calculation = xlAutomatic

End Sub

Sub highlight_column()
'Recorded Macro - Highlight columns L to P

    Columns("L:P").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    
End Sub

Sub sort_col_L()
'Recorded Macro - Sort on column L

    Columns("B:Z").Select
    ActiveWorkbook.Worksheets("Report1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Report1").Sort.SortFields.Add Key:=Range("L2:L800" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Report1").Sort
        .SetRange Range("B1:Z800")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Sub name_me2()
'Add column headings after change in column Level 1

Dim i As Long
Dim N As Long
Dim last_row As Long

                
    Sheets("Report1").Select
    Range("A1:P1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight2  'updated shading by Miriam on 5/30/18
            .TintAndShade = 0.799981688894314 'updated shading by Miriam on 5/30/18
            .PatternTintAndShade = 0
        End With

    last_row = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
    
        N = 2
        
        'compare the values in column L and insert headings when values are different
        For i = 2 To last_row
             If Sheets("Report1").Range("L" & N) <> Sheets("Report1").Range("L" & N + 1) Then
                    Sheets("Report1").Range("A1:Z1").Copy
                    Sheets("Report1").Range("A" & N + 1).Insert Shift:=xlDown
                    N = N + 2
             Else:
                N = N + 1
            End If
        Next
        
End Sub
Sub Insert_Rows()
'Added by Miriam on 5/24/18
'Insert L1_Area row after Header

Dim lRow As Long, iRow As Long

With Worksheets("Report1")
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For iRow = lRow To 1 Step -1
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            .Rows(iRow + 1).Resize(RowSize:=1).Insert xlShiftDown
        End If
    Next iRow
End With

End Sub
Sub Formatting()
'Formatting Report1 for PPT
'Created by Miriam Hamid on 6/4/18


'UpdatingFont All Cells
    Sheets("Report1").Select
    Sheets("Report1").Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Delete Columns
    Range("C:F,M:P").Delete Shift:=xlToLeft

'Add Border
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Call SetRangeBorder(Range("A1:G" & lastrow))

'Autofit All Columns & Rows
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Range("A1").Select
    
'Adjusting Column Width
    Columns("B:B").ColumnWidth = 146.14
    Columns("C:C").ColumnWidth = 9.63
    Columns("D:D").ColumnWidth = 12.13
    Columns("E:E").ColumnWidth = 18.75
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Rows("1:1").EntireRow.AutoFit

'Aligning Columns
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:B").Select
    With Selection
        .WrapText = True
    End With
    Columns("C:H").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    
'Code to select only blank cells in column B between first and last row of data only
'Add subsection for L1_Area
Dim LR As Long
Dim r2 As Long
Dim r3 As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
    For r2 = 1 To LR
        If Cells(r2, "B") = "" Then
            Range(Cells(r2, "B"), Cells(r2, "G")).Merge
                    With Selection
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = True
                    End With
        End If
    Next r2
    
    For r3 = 1 To LR
         If Cells(r3, "B") = "" Then
            Range(Cells(r3, "A"), Cells(r3, "G")).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = -0.149998474074526
                        .PatternTintAndShade = 0
                    End With
        End If
    Next r3
    Range("B1:B" & LR).SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[1]C[6]"
    Selection.Font.Bold = True
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'Find & Replace "Shared Non-O&T"
    Rows("2:2").Select
    Selection.Replace What:="Shared Non-O&T", Replacement:="Operations Shared" _
        , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
            
'Delete Column H
    Range("H:H", "J:J").Delete Shift:=xlToLeft

'Clear Duplicate Header
    Dim N As Long
    N = Cells(Rows.Count, "B").End(xlUp).Row
    For i = N To 2 Step -1
        Set rlook = Range(Cells(i - 1, "B"), Cells(1, 1))
        If Application.WorksheetFunction.CountIf(rlook, Cells(i, "B")) > 0 Then
            Cells(i, "A").Clear
            Cells(i, "B").Clear
            Cells(i, "C").Clear
            Cells(i, "D").Clear
            Cells(i, "E").Clear
            Cells(i, "F").Clear
            Cells(i, "G").Clear
        End If
    Next i

'Rename & Align Header
    Range("B1").FormulaR1C1 = "Audit Name"
    Range("C1").FormulaR1C1 = "Audit Status"
    Range("D1").FormulaR1C1 = "Report Publication Date"
    Range("E1").FormulaR1C1 = "Control Rating"
    Range("F1").FormulaR1C1 = "Report Number"
    Range("G1").FormulaR1C1 = "O&T Business Impacted"
    Range("A1:G1").Select
    Range("G1").Activate
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
      
'Conditional - If Shared OTRC audits
    Dim rng2 As Range
    Dim rngFound2 As Range
    Set rng2 = Range("A2:H2")
    Set rngFound2 = rng2.Find("Operations Shared")
        If rngFound2 Is Nothing Then
        Else
        'Copy Header as Break
            Dim xLastrow As Long
            xrow = Application.InputBox("Choose row to insert header", xTitleId, "", Type:=1)
            xLastrow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
                For i = xrow + 1 To xLastrow Step xrow
                    Rows("1:2").Copy
                    Range(Cells(i, 1), Cells(i, 7)).Insert Shift:=xlDown
                    Application.CutCopyMode = False
                Next
        'Find and replace second instance of "Operations Shared"
            Dim lRow As Long
            lRow = Range("B1").SpecialCells(xlCellTypeLastCell).Row
                Range("A3:G" & lRow).Select
                Selection.Replace What:="Operations Shared", Replacement:= _
                    "Operations Shared, Continued", LookAt:=xlPart, SearchOrder:=xlByRows, _
                    MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                Range("A1").Select
        End If
      
'Delete rows with 0 in column C
    Dim r4 As Long
    FinRow = Cells(Rows.Count, "C").End(xlUp).Row
    
        For r4 = FinRow To 2 Step -1
            If Cells(r4, "C") = "0" Then
                Rows(r4).EntireRow.Delete
            End If
        Next r4
      
End Sub
Sub RunAll()
'Run CopyTech and FormattingTech macros
'Created by Miriam on 6/21/18

Dim rng As Range
Dim rngFound As Range

Set rng = Range("L:L")
Set rngFound = rng.Find("Technology")

Worksheets("Report1").Activate
    If rngFound Is Nothing Then
    Else
        Call CopyTech
        Call FormattingTech
    End If

   'Add filters back on in Audit Plan Sheet
   'Code added by Miriam Hamid 5/30/19
    Sheets("Audit_Plan").Select
    Range("A6:DH6").AutoFilter

End Sub
Sub CopyTech()
'Formatting Technology Section for PPT into TechReport Sheet
'Created by Miriam Hamid on 6/21/18

Dim findrow As Long, findrow2 As Long

Worksheets("Report1").Activate
    On Error GoTo errhandler
    findrow = Range("L:L").Find("Technology", Range("L1")).Row
    findrow2 = Range("L:L").Find("L1_Area", Range("L" & findrow)).Row
    Range("B" & findrow & ":W" & findrow2 - 1).Copy
    Worksheets("TechReport").Activate
    Worksheets("TechReport").Range("J2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        With Selection.Font
            .Name = "Arial"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    Application.CutCopyMode = False
    Exit Sub
errhandler:
        MsgBox "No Cells containing specified text found"

End Sub
Sub FormattingTech()
'Formatting Technology Section for PPT
'Created by Miriam Hamid on 6/21/18
'Updated by Miriam Hamid on 6/3/19

'Moving columns
    Columns("S:S").Cut
    Columns("J:J").Insert Shift:=xlToRight
    Columns("R:R").Cut
    Columns("M:M").Insert Shift:=xlToRight
    Columns("R:R").Cut
    Columns("O:O").Insert Shift:=xlToRight
    
'Delete columns
    Range("N:N,P:Q,S:U,W:X").Delete Shift:=xlToLeft
    
'Find Blanks in columns M & N and add N/A
Dim endRow As Long
Dim d As Range
endRow = Range("K" & Rows.Count).End(xlUp).Row

    For Each d In Range("M2:N" & endRow)
        If d.Value = vbNullString Then d.Value = "N/A"
    Next
    'Range("M2:N" & endRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "N/A"
    
'Sort Business
    Range("J1").Select
    ActiveWorkbook.Worksheets("TechReport").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TechReport").Sort.SortFields.Add Key:=Range("J2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TechReport").Sort
        .SetRange Range("J2:W100")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("J:J").EntireColumn.AutoFit
    
'Remove "Technology" from Business Names
    Columns("J:J").Select
    Selection.Replace What:="GCB Technology", Replacement:="GCB Tech", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="ICG Technology", Replacement:="ICG Tech", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
'Insert Two Column to create gap for note
    Range("R:S").EntireColumn.Insert
        
'Header Creation and Formatting
    Range("J1").FormulaR1C1 = "Business"
    Range("K1").FormulaR1C1 = "Audit Name"
    Range("L1").FormulaR1C1 = "Audit Type"
    Range("M1").FormulaR1C1 = "Control Rating"
    Range("N1").FormulaR1C1 = "Report Publication Date"
    Range("O1").FormulaR1C1 = "Review Status"
    Range("P1").FormulaR1C1 = "=IF(MONTH(EOMONTH(TODAY(),-1))<=3,""Rated 1Q ""&YEAR(EOMONTH(TODAY(),-1)),IF(MONTH(EOMONTH(TODAY(),-1))<=6,""Rated 2Q ""&YEAR(EOMONTH(TODAY(),-1)),IF(MONTH(EOMONTH(TODAY(),-1))<=9,""Rated 3Q ""&YEAR(EOMONTH(TODAY(),-1)),""Rated 4Q""&YEAR(EOMONTH(TODAY(),-1)))))"
    Range("Q1").FormulaR1C1 = "=IF(MONTH(EOMONTH(TODAY(),-1))<=3,""Not Rated 1Q ""&YEAR(EOMONTH(TODAY(),-1)),IF(MONTH(EOMONTH(TODAY(),-1))<=6,""Not Rated 2Q ""&YEAR(EOMONTH(TODAY(),-1)),IF(MONTH(EOMONTH(TODAY(),-1))<=9,""Not Rated 3Q ""&YEAR(EOMONTH(TODAY(),-1)),""Not Rated 4Q""&YEAR(EOMONTH(TODAY(),-1)))))"
    Range("R1").FormulaR1C1 = "Total"
    
    Range("J1:R1").Select
        With Selection
            .Interior.Pattern = xlSolid
            .Interior.PatternColorIndex = xlAutomatic
            .Interior.ThemeColor = xlThemeColorDark1
            .Interior.TintAndShade = -0.149998474074526
            .Interior.PatternTintAndShade = 0
            .Font.Name = "Arial"
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    Range("J1").Select

'Aligning Columns
Columns("L:R").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("J2").Select

'Add Border
Dim lastrow As Long
lastrow = Cells(Rows.Count, "J").End(xlUp).Offset(1).Row
Call SetRangeBorder(Range("J1:R" & lastrow))

'Formula to count Rated/Not Rated Audits/Total (columns P&Q)
    Range("P2:P" & endRow).formula = "=IF(AND(RC[-4]<>""Risk Based"")*OR(RC[-3]=""NR/NA"",RC[-3]=""Not Rated"",RC[-3]=""Not Applicable"",RC[-3]=""N/A""),""-"",""1"")"
    Range("Q2:Q" & endRow).formula = "=IF(AND(RC[-5]<>""Risk Based"")*OR(RC[-4]=""NR/NA"",RC[-4]=""Not Rated"",RC[-4]=""Not Applicable"",RC[-4]=""N/A""),""1"",""-"")"

'Convert TextToColumn
    Range("P2:P" & endRow).Select
    With Selection
        .NumberFormat = "General"
        .Value = .Value
    End With

    Range("Q2:Q" & endRow).Select
    With Selection
        .NumberFormat = "General"
        .Value = .Value
    End With

'Formula to Sum Columns P&Q after they have been convereted to number
    Range("R2:R" & endRow).formula = "=SUM(RC[-2]:RC[-1])"

'Copy Formula and Paste Special Values - Remove Formula
    Range("P2:R2" & endRow).Copy
    Range("P2:R2" & endRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'Adding footer for each section and grand total
Dim LR As Long
Dim X As Long
LR = Range("J" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For X = LR + 1 To 3 Step -1
    If Cells(X, 10).Value <> Cells(X - 1, 10) Then
        Rows(X).Insert
            With Range("J" & X)
                .Value = .Offset(-1).Value & " Total"
                .Font.Bold = True
                .Resize(, 8).Borders.LineStyle = xlNone
                .Resize(, 8).BorderAround xlContinuous, xlThin
                .Resize(, 7).Borders.LineStyle = xlNone
                .Resize(, 7).BorderAround xlContinuous, xlThin
                .Resize(, 6).Borders.LineStyle = xlNone
                .Resize(, 6).BorderAround xlContinuous, xlThin
                .Resize(, 9).Interior.Color = RGB(220, 230, 241)
            End With
    End If
Next X
    With Range("J" & Cells(Rows.Count, "J").End(xlUp).Row + 1)
        .Value = "Grand Total"
        .Resize(, 9).Interior.Color = 14857357
        .Resize(, 8).Borders.LineStyle = xlNone
        .Resize(, 8).BorderAround xlContinuous, xlThin
        .Resize(, 7).Borders.LineStyle = xlNone
        .Resize(, 7).BorderAround xlContinuous, xlThin
        .Resize(, 6).Borders.LineStyle = xlNone
        .Resize(, 6).BorderAround xlContinuous, xlThin
        .Resize(, 9).Font.Bold = True
        .Resize(, 9).Font.Name = "Arial"
        .Resize(, 9).Font.Size = 8
    End With
Application.ScreenUpdating = True

'Adding Totals
Dim rng As Range
    For Each rng In Range("P:P").SpecialCells(xlConstants).Areas
       rng.Offset(rng.Count).Resize(1, 1).formula = "=sum(" & rng.Address & ")"
       rng.Offset(rng.Count).Resize(1, 1).Font.Bold = True
    Next rng
    With Range("P" & Rows.Count).End(xlUp).Offset(1)
        .formula = "=sum(" & Range("O2:O" & .Row - 1).SpecialCells(xlBlanks).Offset(, 1).Address & ")"
    End With
    
    For Each rng In Range("Q:Q").SpecialCells(xlConstants).Areas
       rng.Offset(rng.Count).Resize(1, 1).formula = "=sum(" & rng.Address & ")"
       rng.Offset(rng.Count).Resize(1, 1).Font.Bold = True
    Next rng
    With Range("Q" & Rows.Count).End(xlUp).Offset(1)
        .formula = "=sum(" & Range("O2:O" & .Row - 1).SpecialCells(xlBlanks).Offset(, 2).Address & ")"
    End With
    
    For Each rng In Range("R:R").SpecialCells(xlConstants).Areas
       rng.Offset(rng.Count).Resize(1, 1).formula = "=sum(" & rng.Address & ")"
       rng.Offset(rng.Count).Resize(1, 1).Font.Bold = True
    Next rng
    With Range("R" & Rows.Count).End(xlUp).Offset(1)
        .formula = "=sum(" & Range("O2:O" & .Row - 1).SpecialCells(xlBlanks).Offset(, 3).Address & ")"
    End With

'Remove Formula
    Columns("P:R").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'Merge & Align Businesses Types
Dim lRow As Long
Dim c As Range
    lRow = Cells(Rows.Count, "J").End(xlUp).Row
    Application.DisplayAlerts = False
    For i = lRow To 2 Step -1
        If Cells(i, 10) = Cells(i - 1, 10) Then
            Range(Cells(i, 10), Cells(i - 1, 10)).Merge
        End If
    Next i
    Application.DisplayAlerts = True
    For Each c In ActiveSheet.UsedRange
        If c.MergeCells Then
                c.HorizontalAlignment = xlLeft
                c.VerticalAlignment = xlTop
                c.WrapText = True
                c.Orientation = 0
                c.AddIndent = False
                c.IndentLevel = 0
                c.ShrinkToFit = False
                c.ReadingOrder = xlContext
        End If
    Next
    
'Formatting font to size 8
    Range("Q:W").Select
        With Selection
            .Font.Size = 8
        End With
    Range("J1").Select

'Copy data to CIOC File
    Worksheets("CIOC File").Activate
        Range("J21:W80").Delete Shift:=xlToLeft
        Range("J21").Select
    Worksheets("TechReport").Activate
    'Range("J1", Range("W" & Rows.Count).End(xlUp)).Copy
    Range("J1:W" & lRow).Copy
    Worksheets("CIOC File").Activate
    Application.DisplayAlerts = False
    Worksheets("CIOC File").Range("J21").Select
    ActiveSheet.Paste
    'Worksheets("CIOC File").Range("J21").PasteSpecial Paste:=xlPasteAll
    Range("J21").Select
    Application.DisplayAlerts = True
    
'Clear data
    Dim sheet As Worksheet
    Set sheet = Sheets.Add
        Application.DisplayAlerts = False
        Sheets("TechReport").Delete
        Application.DisplayAlerts = True
        sheet.Name = "TechReport"
 
'Move TechReport sheet
    Sheets("TechReport").Select
    Sheets("TechReport").Move Before:=Sheets(28)

'Hide TechReport Sheet
Sheets("TechReport").Visible = False
 
End Sub
Sub SetRangeBorder(poRng As Range)
    If Not poRng Is Nothing Then
        poRng.Borders(xlDiagonalDown).LineStyle = xlNone
        poRng.Borders(xlDiagonalUp).LineStyle = xlNone
        poRng.Borders(xlEdgeLeft).LineStyle = xlContinuous
        poRng.Borders(xlEdgeTop).LineStyle = xlContinuous
        poRng.Borders(xlEdgeBottom).LineStyle = xlContinuous
        poRng.Borders(xlEdgeRight).LineStyle = xlContinuous
        poRng.Borders(xlInsideVertical).LineStyle = xlContinuous
        poRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
End Sub


Sub Copy_ActiveSheet_New_Workbook()
'copy the active worksheet to a new workbook

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    'Set Sourcewb = ActiveWorkbook

    FileExtStr = ".xlsx": FileFormatNum = 51
    
    'Copy the sheet to a new workbook
    Sheets("Report1").Copy
    Set Destwb = ActiveWorkbook

    TempFilePath = Application.DefaultFilePath & "\"
    TempFileName = "O&T Owned Audits " & Format(Now, "mm-dd-yyyy hh-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close savechanges:=False
    End With

    MsgBox "You can find the new file in " & TempFilePath
    

End Sub

Sub CopyOT_AP_Info(qtr_num As String)

    app_functions_OFF 'Turn off features
    Unload frm_oc_export 'close form
    
    Dim last_row As Long 'calculate the last row in column
    Dim i As Long
    
    last_row = Sheets("Audit_Plan").Range("A" & Rows.Count).End(xlUp).Row
    lRow = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
    
    'code to clear contents of destination sheet
        Sheets("Report1").Cells.Clear   'updated to Clear All instead of just Contents by Miriam Hamid on 6/4/18
        Sheets("Report1").Activate
        Sheets("Report1").Cells.Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
    With Sheets("Audit_Plan").Range("A6:BO" & last_row)
            
            'Quarter
            .AutoFilter Field:=1, Criteria1:=qtr_num
            'Unique Audit Count
            .AutoFilter Field:=11, Criteria1:=1
            'Entity Ownership
            .AutoFilter Field:=51, Criteria1:="O&T Area"
'            'Report Flag
'            .AutoFilter Field:=57, Criteria1:="Yes"   '(Disbaled by Miriam Hamid on 5/30/19)
            
            'Audit Name
            .Range("G1:G" & last_row).Copy
                Sheets("Report1").Range("B1").PasteSpecial xlPasteValues
            'Audit Type
            .Range("I1:I" & last_row).Copy
                Sheets("Report1").Range("C1").PasteSpecial xlPasteValues
            'Fieldwork Start Date
            '.Range("O1:O" & last_row).Copy
            '    Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Monthly BUR Confirmation Date
            .Range("X1:X" & last_row).Copy
                Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Fieldwork End Date
            .Range("Q1:Q" & last_row).Copy
                Sheets("Report1").Range("E1").PasteSpecial xlPasteValues
            'ITA or AAM Memos Available?
            .Range("Y1:Y" & last_row).Copy
                Sheets("Report1").Range("F1").PasteSpecial xlPasteValues
            'Audit Status
            .Range("V1:V" & last_row).Copy
                Sheets("Report1").Range("G1").PasteSpecial xlPasteValues
            'Report Publication Date
            .Range("Z1:Z" & last_row).Copy
                Sheets("Report1").Range("H1").PasteSpecial xlPasteValues
            'Control Rating
            .Range("AA1:AA" & last_row).Copy
                Sheets("Report1").Range("I1").PasteSpecial xlPasteValues
            'Report Number
            .Range("AB1:AB" & last_row).Copy
                Sheets("Report1").Range("J1").PasteSpecial xlPasteValues
            'L2
            .Range("BA1:BA" & last_row).Copy
                Sheets("Report1").Range("K1").PasteSpecial xlPasteValues
                  
            'Filter fields that will not show in report
            
            'L1
            .Range("AZ1:AZ" & last_row).Copy
                Sheets("Report1").Range("L1").PasteSpecial xlPasteValues
            'Report Flag
            .Range("BK1:BK" & last_row).Copy
                Sheets("Report1").Range("M1").PasteSpecial xlPasteValues
            'Unique Audit Count
            .Range("K1:K" & last_row).Copy
                Sheets("Report1").Range("N1").PasteSpecial xlPasteValues
            'QTR
            .Range("A1:A" & last_row).Copy
                Sheets("Report1").Range("O1").PasteSpecial xlPasteValues
            'Entity Ownership
            .Range("AY1:AY" & last_row).Copy
                Sheets("Report1").Range("P1").PasteSpecial xlPasteValues
            
            .AutoFilter
            
    End With
        
        'Changes the name of the column heading
        Sheets("Report1").Range("K1").Value = "O&T Area Area"
        
        'Format columns containing dates
        Sheets("Report1").Columns("D:D").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("E:E").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("H:H").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("S:S").NumberFormat = "mm/dd/yyyy;@"
        
        'Turn on Calculations
        Application.Calculation = xlAutomatic
        
        'Calcualted Field1 (Updated Audit Status)
        With Sheets("Report1")
            .Range("R2:R" & lRow).formula = "=IF(RC[-15]=""IER"",RC[-11],IF(AND(RC[-11]=""Completed"",RC[-14]=""""),""In Progress"",RC[-11]))"
        'Calcualted Field2 (Updated Report Publication Date)
            .Range("S2:S" & lRow).formula = "=IF(RC[-16]=""IER"",RC[-11],IF(RC[-15]="""","""",RC[-11]))"
        'Calcualted Field3 (Updated Control Rating)
            .Range("T2:T" & lRow).formula = "=IF(RC[-17]=""IER"",RC[-11],IF(RC[-16]="""","""",RC[-11]))"
        'Calculated Field4 (Updated Report Number)
            .Range("U2:U" & lRow).formula = "=IF(RC[-18]=""IER"",RC[-11],IF(RC[-17]="""","""",RC[-11]))"
        'Calculated Field5 (Note for Completed Audits after month end)
            .Range("V2:V" & lRow).formula = "=IF(RC[-19]=""IER"","""",IF(AND(RC[-14]<>"""",RC[-14]<=(EOMONTH(TODAY(),-1)+1),RC[-18]=""""),""Audit published with ""&RC[-13]&"" rating on ""&TEXT(RC[-14],""mm/dd/yy"")&"", but was not confirmed as a closed audit by IA reporting due to AIMS system not updated by month end"",IF(AND(RC[-14]>=(EOMONTH(TODAY(),-1)+1),RC[-18]=""""),""Published as ""&RC[-13]&"" on ""&TEX" & _
        "T(RC[-14],""mm/dd/yy""),"""")))" & _
        ""
                
        'Copy Paste Value - Remove Formulas
            Columns("R:V").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("R2").Select
            Application.CutCopyMode = False
            
        'Copy Calculated Fields data
            .Range("R2:R" & lRow).Copy
            .Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("S2:S" & lRow).Copy
            .Range("H2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("T2:T" & lRow).Copy
            .Range("I2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("U2:U" & lRow).Copy
            .Range("J2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
              
        'Delete Calculated Fields Columns
        Range("R:U").Delete
        End With
        
        'Turn off Calculations
        Application.Calculation = xlManual
                
        'Clear Clipboard
        Application.CutCopyMode = False
                
        'call the remaining programs to finish the process
        export_oc_dec
    
End Sub


Sub CopyNON_OT_AP_Info(qtr_num2 As String)

    'Turn off features
    app_functions_OFF
    Unload frm_oc_export
    
    Dim last_row As Long 'calculate the last row in column
    Dim i As Long
    
    last_row = Sheets("Audit_Plan").Range("A" & Rows.Count).End(xlUp).Row
    lRow = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
        
    'code to clear contents of destination sheet
        Sheets("Report1").Cells.Clear       'updated to Clear All instead of just Contents by Miriam Hamid on 6/4/18
        Sheets("Report1").Activate
        Sheets("Report1").Cells.Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
    With Sheets("Audit_Plan").Range("A6:BO" & last_row)
            
            .AutoFilter Field:=1, Criteria1:=qtr_num2
            'Unique Count
            .AutoFilter Field:=11, Criteria1:=1
            'Entity Ownership
            .AutoFilter Field:=51, Criteria1:="Non-O&T"
            'L1
            .AutoFilter Field:=52, Criteria1:="Shared Non-O&T"
 '           'Report Flag
 '           .AutoFilter Field:=63, Criteria1:="Yes"     '(Disbaled by Miriam Hamid on 5/30/19)
            
            
            'Audit Name
            .Range("G1:G" & last_row).Copy
                Sheets("Report1").Range("B1").PasteSpecial xlPasteValues
            'Audit Type
            .Range("I1:I" & last_row).Copy
                Sheets("Report1").Range("C1").PasteSpecial xlPasteValues
            'Fieldwork Start Date
            '.Range("O1:O" & last_row).Copy
            '    Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Monthly BUR Confirmation Date
            .Range("X1:X" & last_row).Copy
                Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Fieldwork End Date
            .Range("Q1:Q" & last_row).Copy
                Sheets("Report1").Range("E1").PasteSpecial xlPasteValues
            'ITA or AAM Memos Available?
            .Range("U1:U" & last_row).Copy
                Sheets("Report1").Range("F1").PasteSpecial xlPasteValues
            'Audit Status
            .Range("V1:V" & last_row).Copy
                Sheets("Report1").Range("G1").PasteSpecial xlPasteValues
            'Report Publication Date
            .Range("Z1:Z" & last_row).Copy
                Sheets("Report1").Range("H1").PasteSpecial xlPasteValues
            'Control Rating
            .Range("AA1:AA" & last_row).Copy
                Sheets("Report1").Range("I1").PasteSpecial xlPasteValues
            'Report Number
            .Range("AB1:AB" & last_row).Copy
                Sheets("Report1").Range("J1").PasteSpecial xlPasteValues
            'Business Impacted
            .Range("BC1:BC" & last_row).Copy
                Sheets("Report1").Range("K1").PasteSpecial xlPasteValues
            
            'Filter fields that will not show in report
            
            'L1
            .Range("AZ1:AZ" & last_row).Copy
                Sheets("Report1").Range("L1").PasteSpecial xlPasteValues
            'Report Flag
            .Range("BK1:BK" & last_row).Copy
                Sheets("Report1").Range("M1").PasteSpecial xlPasteValues
            'Unique Audit Count
            .Range("K1:K" & last_row).Copy
                Sheets("Report1").Range("N1").PasteSpecial xlPasteValues
            'QTR
            .Range("A1:A" & last_row).Copy
                Sheets("Report1").Range("O1").PasteSpecial xlPasteValues
            'Entity Ownership
            .Range("AY1:AY" & last_row).Copy
                Sheets("Report1").Range("P1").PasteSpecial xlPasteValues
            
            .AutoFilter

    End With
                
        'Changes the name of the column heading
        Sheets("Report1").Range("K1").Value = "O&T Business Impacted"
        
        'Format columns containing dates
        Sheets("Report1").Columns("D:D").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("E:E").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("H:H").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("S:S").NumberFormat = "mm/dd/yyyy;@"
        
        'Turn on Calculations
        Application.Calculation = xlAutomatic
        
        'Calcualted Field1 (Updated Audit Status)
        With Sheets("Report1")
            .Range("R2:R" & lRow).formula = "=IF(RC[-15]=""IER"",RC[-11],IF(AND(RC[-11]=""Completed"",RC[-14]=""""),""In Progress"",RC[-11]))"
        'Calcualted Field2 (Updated Report Publication Date)
            .Range("S2:S" & lRow).formula = "=IF(RC[-16]=""IER"",RC[-11],IF(RC[-15]="""","""",RC[-11]))"
        'Calcualted Field3 (Updated Control Rating)
            .Range("T2:T" & lRow).formula = "=IF(RC[-17]=""IER"",RC[-11],IF(RC[-16]="""","""",RC[-11]))"
        'Calculated Field4 (Updated Report Number)
            .Range("U2:U" & lRow).formula = "=IF(RC[-18]=""IER"",RC[-11],IF(RC[-17]="""","""",RC[-11]))"
        
        'Copy Paste Value - Remove Formulas
            Columns("R:U").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("R2").Select
            Application.CutCopyMode = False
            
        'Copy Calculated Fields data
            .Range("R2:R" & lRow).Copy
            .Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("S2:S" & lRow).Copy
            .Range("H2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("T2:T" & lRow).Copy
            .Range("I2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("U2:U" & lRow).Copy
            .Range("J2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
              
        'Delete Calculated Fields Columns
        Range("R:U").Delete
        End With
        
        'Turn off Calculations
        Application.Calculation = xlManual
        
        'Clear Clipboard
        Application.CutCopyMode = False
        
        app_functions_ON 'Turn off features to speed up program
        
        export_oc_dec

End Sub

I believe the error is somewhere within these two subs of the code above.
Code:
Sub CopyOT_AP_Info(qtr_num As String)

    app_functions_OFF 'Turn off features
    Unload frm_oc_export 'close form
    
    Dim last_row As Long 'calculate the last row in column
    Dim i As Long
    
    last_row = Sheets("Audit_Plan").Range("A" & Rows.Count).End(xlUp).Row
    lRow = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
    
    'code to clear contents of destination sheet
        Sheets("Report1").Cells.Clear   'updated to Clear All instead of just Contents by Miriam Hamid on 6/4/18
        Sheets("Report1").Activate
        Sheets("Report1").Cells.Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
    With Sheets("Audit_Plan").Range("A6:BO" & last_row)
            
            'Quarter
            .AutoFilter Field:=1, Criteria1:=qtr_num
            'Unique Audit Count
            .AutoFilter Field:=11, Criteria1:=1
            'Entity Ownership
            .AutoFilter Field:=51, Criteria1:="O&T Area"
'            'Report Flag
'            .AutoFilter Field:=57, Criteria1:="Yes"   '(Disbaled by Miriam Hamid on 5/30/19)
            
            'Audit Name
            .Range("G1:G" & last_row).Copy
                Sheets("Report1").Range("B1").PasteSpecial xlPasteValues
            'Audit Type
            .Range("I1:I" & last_row).Copy
                Sheets("Report1").Range("C1").PasteSpecial xlPasteValues
            'Fieldwork Start Date
            '.Range("O1:O" & last_row).Copy
            '    Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Monthly BUR Confirmation Date
            .Range("X1:X" & last_row).Copy
                Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Fieldwork End Date
            .Range("Q1:Q" & last_row).Copy
                Sheets("Report1").Range("E1").PasteSpecial xlPasteValues
            'ITA or AAM Memos Available?
            .Range("Y1:Y" & last_row).Copy
                Sheets("Report1").Range("F1").PasteSpecial xlPasteValues
            'Audit Status
            .Range("V1:V" & last_row).Copy
                Sheets("Report1").Range("G1").PasteSpecial xlPasteValues
            'Report Publication Date
            .Range("Z1:Z" & last_row).Copy
                Sheets("Report1").Range("H1").PasteSpecial xlPasteValues
            'Control Rating
            .Range("AA1:AA" & last_row).Copy
                Sheets("Report1").Range("I1").PasteSpecial xlPasteValues
            'Report Number
            .Range("AB1:AB" & last_row).Copy
                Sheets("Report1").Range("J1").PasteSpecial xlPasteValues
            'L2
            .Range("BA1:BA" & last_row).Copy
                Sheets("Report1").Range("K1").PasteSpecial xlPasteValues
                  
            'Filter fields that will not show in report
            
            'L1
            .Range("AZ1:AZ" & last_row).Copy
                Sheets("Report1").Range("L1").PasteSpecial xlPasteValues
            'Report Flag
            .Range("BK1:BK" & last_row).Copy
                Sheets("Report1").Range("M1").PasteSpecial xlPasteValues
            'Unique Audit Count
            .Range("K1:K" & last_row).Copy
                Sheets("Report1").Range("N1").PasteSpecial xlPasteValues
            'QTR
            .Range("A1:A" & last_row).Copy
                Sheets("Report1").Range("O1").PasteSpecial xlPasteValues
            'Entity Ownership
            .Range("AY1:AY" & last_row).Copy
                Sheets("Report1").Range("P1").PasteSpecial xlPasteValues
            
            .AutoFilter
            
    End With
        
        'Changes the name of the column heading
        Sheets("Report1").Range("K1").Value = "O&T Area Area"
        
        'Format columns containing dates
        Sheets("Report1").Columns("D:D").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("E:E").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("H:H").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("S:S").NumberFormat = "mm/dd/yyyy;@"
        
        'Turn on Calculations
        Application.Calculation = xlAutomatic
        
        'Calcualted Field1 (Updated Audit Status)
        With Sheets("Report1")
            .Range("R2:R" & lRow).formula = "=IF(RC[-15]=""IER"",RC[-11],IF(AND(RC[-11]=""Completed"",RC[-14]=""""),""In Progress"",RC[-11]))"
        'Calcualted Field2 (Updated Report Publication Date)
            .Range("S2:S" & lRow).formula = "=IF(RC[-16]=""IER"",RC[-11],IF(RC[-15]="""","""",RC[-11]))"
        'Calcualted Field3 (Updated Control Rating)
            .Range("T2:T" & lRow).formula = "=IF(RC[-17]=""IER"",RC[-11],IF(RC[-16]="""","""",RC[-11]))"
        'Calculated Field4 (Updated Report Number)
            .Range("U2:U" & lRow).formula = "=IF(RC[-18]=""IER"",RC[-11],IF(RC[-17]="""","""",RC[-11]))"
        'Calculated Field5 (Note for Completed Audits after month end)
            .Range("V2:V" & lRow).formula = "=IF(RC[-19]=""IER"","""",IF(AND(RC[-14]<>"""",RC[-14]<=(EOMONTH(TODAY(),-1)+1),RC[-18]=""""),""Audit published with ""&RC[-13]&"" rating on ""&TEXT(RC[-14],""mm/dd/yy"")&"", but was not confirmed as a closed audit by IA reporting due to AIMS system not updated by month end"",IF(AND(RC[-14]>=(EOMONTH(TODAY(),-1)+1),RC[-18]=""""),""Published as ""&RC[-13]&"" on ""&TEX" & _
        "T(RC[-14],""mm/dd/yy""),"""")))" & _
        ""
                
        'Copy Paste Value - Remove Formulas
            Columns("R:V").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("R2").Select
            Application.CutCopyMode = False
            
        'Copy Calculated Fields data
            .Range("R2:R" & lRow).Copy
            .Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("S2:S" & lRow).Copy
            .Range("H2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("T2:T" & lRow).Copy
            .Range("I2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("U2:U" & lRow).Copy
            .Range("J2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
              
        'Delete Calculated Fields Columns
        Range("R:U").Delete
        End With
        
        'Turn off Calculations
        Application.Calculation = xlManual
                
        'Clear Clipboard
        Application.CutCopyMode = False
                
        'call the remaining programs to finish the process
        export_oc_dec
    
End Sub


Sub CopyNON_OT_AP_Info(qtr_num2 As String)

    'Turn off features
    app_functions_OFF
    Unload frm_oc_export
    
    Dim last_row As Long 'calculate the last row in column
    Dim i As Long
    
    last_row = Sheets("Audit_Plan").Range("A" & Rows.Count).End(xlUp).Row
    lRow = Sheets("Report1").Range("B" & Rows.Count).End(xlUp).Row
        
    'code to clear contents of destination sheet
        Sheets("Report1").Cells.Clear       'updated to Clear All instead of just Contents by Miriam Hamid on 6/4/18
        Sheets("Report1").Activate
        Sheets("Report1").Cells.Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
    With Sheets("Audit_Plan").Range("A6:BO" & last_row)
            
            .AutoFilter Field:=1, Criteria1:=qtr_num2
            'Unique Count
            .AutoFilter Field:=11, Criteria1:=1
            'Entity Ownership
            .AutoFilter Field:=51, Criteria1:="Non-O&T"
            'L1
            .AutoFilter Field:=52, Criteria1:="Shared Non-O&T"
 '           'Report Flag
 '           .AutoFilter Field:=63, Criteria1:="Yes"     '(Disbaled by Miriam Hamid on 5/30/19)
            
            
            'Audit Name
            .Range("G1:G" & last_row).Copy
                Sheets("Report1").Range("B1").PasteSpecial xlPasteValues
            'Audit Type
            .Range("I1:I" & last_row).Copy
                Sheets("Report1").Range("C1").PasteSpecial xlPasteValues
            'Fieldwork Start Date
            '.Range("O1:O" & last_row).Copy
            '    Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Monthly BUR Confirmation Date
            .Range("X1:X" & last_row).Copy
                Sheets("Report1").Range("D1").PasteSpecial xlPasteValues
            'Fieldwork End Date
            .Range("Q1:Q" & last_row).Copy
                Sheets("Report1").Range("E1").PasteSpecial xlPasteValues
            'ITA or AAM Memos Available?
            .Range("U1:U" & last_row).Copy
                Sheets("Report1").Range("F1").PasteSpecial xlPasteValues
            'Audit Status
            .Range("V1:V" & last_row).Copy
                Sheets("Report1").Range("G1").PasteSpecial xlPasteValues
            'Report Publication Date
            .Range("Z1:Z" & last_row).Copy
                Sheets("Report1").Range("H1").PasteSpecial xlPasteValues
            'Control Rating
            .Range("AA1:AA" & last_row).Copy
                Sheets("Report1").Range("I1").PasteSpecial xlPasteValues
            'Report Number
            .Range("AB1:AB" & last_row).Copy
                Sheets("Report1").Range("J1").PasteSpecial xlPasteValues
            'Business Impacted
            .Range("BC1:BC" & last_row).Copy
                Sheets("Report1").Range("K1").PasteSpecial xlPasteValues
            
            'Filter fields that will not show in report
            
            'L1
            .Range("AZ1:AZ" & last_row).Copy
                Sheets("Report1").Range("L1").PasteSpecial xlPasteValues
            'Report Flag
            .Range("BK1:BK" & last_row).Copy
                Sheets("Report1").Range("M1").PasteSpecial xlPasteValues
            'Unique Audit Count
            .Range("K1:K" & last_row).Copy
                Sheets("Report1").Range("N1").PasteSpecial xlPasteValues
            'QTR
            .Range("A1:A" & last_row).Copy
                Sheets("Report1").Range("O1").PasteSpecial xlPasteValues
            'Entity Ownership
            .Range("AY1:AY" & last_row).Copy
                Sheets("Report1").Range("P1").PasteSpecial xlPasteValues
            
            .AutoFilter

    End With
                
        'Changes the name of the column heading
        Sheets("Report1").Range("K1").Value = "O&T Business Impacted"
        
        'Format columns containing dates
        Sheets("Report1").Columns("D:D").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("E:E").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("H:H").NumberFormat = "mm/dd/yyyy;@"
        Sheets("Report1").Columns("S:S").NumberFormat = "mm/dd/yyyy;@"
        
        'Turn on Calculations
        Application.Calculation = xlAutomatic
        
        'Calcualted Field1 (Updated Audit Status)
        With Sheets("Report1")
            .Range("R2:R" & lRow).formula = "=IF(RC[-15]=""IER"",RC[-11],IF(AND(RC[-11]=""Completed"",RC[-14]=""""),""In Progress"",RC[-11]))"
        'Calcualted Field2 (Updated Report Publication Date)
            .Range("S2:S" & lRow).formula = "=IF(RC[-16]=""IER"",RC[-11],IF(RC[-15]="""","""",RC[-11]))"
        'Calcualted Field3 (Updated Control Rating)
            .Range("T2:T" & lRow).formula = "=IF(RC[-17]=""IER"",RC[-11],IF(RC[-16]="""","""",RC[-11]))"
        'Calculated Field4 (Updated Report Number)
            .Range("U2:U" & lRow).formula = "=IF(RC[-18]=""IER"",RC[-11],IF(RC[-17]="""","""",RC[-11]))"
        
        'Copy Paste Value - Remove Formulas
            Columns("R:U").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("R2").Select
            Application.CutCopyMode = False
            
        'Copy Calculated Fields data
            .Range("R2:R" & lRow).Copy
            .Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("S2:S" & lRow).Copy
            .Range("H2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("T2:T" & lRow).Copy
            .Range("I2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
            .Range("U2:U" & lRow).Copy
            .Range("J2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False
              
        'Delete Calculated Fields Columns
        Range("R:U").Delete
        End With
        
        'Turn off Calculations
        Application.Calculation = xlManual
        
        'Clear Clipboard
        Application.CutCopyMode = False
        
        app_functions_ON 'Turn off features to speed up program
        
        export_oc_dec

End Sub

Please let me know if you need any further information. Your assistance is greatly appreciated.
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,695
Posting your workbook for review would help a great deal.
 

MHamid

Active Member
Joined
Jan 31, 2013
Messages
357
Workbook has sensitive data. I could probably try to gather dummy data, but might take a while
 

Watch MrExcel Video

Forum statistics

Threads
1,111,432
Messages
5,540,791
Members
410,525
Latest member
Ahmed23236
Top