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?
I believe the error is somewhere within these two subs of the code above.
Please let me know if you need any further information. Your assistance is greatly appreciated.
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 SubI 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 SubPlease let me know if you need any further information. Your assistance is greatly appreciated.
