I have an issue with the code below (have added ** next to the lines which I think cause the problem). Essentially I am asking the code to:
- Create a new tab based on some array variables
- Copy paste some headers from a related tab
- Cut any row which does not pass the 'For each Cell..' check on the related tab, into the newly created one.
The code does not actually bug, but it seems like it is not able to perform the 'For each Cell...' check (Step 3). More specifically If I run the code line by line, Step 3 is correctly carried out. However, If the code is run via F5 in its entirety, the end product will only reach Step 2, de facto overlooking Step 3. I am just wondering whether this is something to do with the IF Statements? Any help massively appreciated! Code below:
Option Explicit
Public Cell, WshtNames As Variant, Check_Tab, Bench_OAS_Level, Bench_OAS_Change, Bench_Spread_Dur, Bench_Duration, Bench_Convexity As Worksheet, FirstHeaderColumn, LRow, LastRow, w As Long, CalcRange, FirstHeaderRow, LastColumn As Range, wb As Workbook
Sub Definitions()
Set wb = Workbooks("TEST Overview Tool Barclays May 2018.xlsm")
Set Bench_OAS_Level = wb.Worksheets("Bench OAS Level")
Set Bench_OAS_Change = wb.Worksheets("Bench OAS Change")
Set Bench_Spread_Dur = wb.Worksheets("Bench Spread Dur")
Set Bench_Duration = wb.Worksheets("Bench Duration")
Set Bench_Convexity = wb.Worksheets("Bench Convexity")
Set Check_Tab = wb.Worksheets("Check")
WshtNames = Array("Bench OAS Level", "Bench OAS Change", "Bench Spread Dur", "Bench Duration", "Bench Convexity")
End Sub
Sub Check_OOT()
Call Definitions
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Call Destination_Tab_Format
For w = LBound(WshtNames, 1) To UBound(WshtNames, 1)
With wb.Worksheets(WshtNames(w))
Set LastColumn = .UsedRange.Find("Total", , xlValues, xlWhole)
Set FirstHeaderRow = .UsedRange.Find("Level 1", , xlValues, xlWhole)
FirstHeaderColumn = FirstHeaderRow.Column - 1
LastRow = .Cells(Rows.Count, LastColumn.Column).End(xlUp).Row
Set CalcRange = .Range(.Cells(FirstHeaderRow.Row + 2, FirstHeaderRow.Column + 3), .Cells(LastRow, LastColumn.Column))
If WshtNames(w) = "Bench OAS Level" Then
.Range(.Cells(1, 1), .Cells(FirstHeaderRow.Row, LastColumn.Column)).Copy
**Worksheets(WshtNames(w) & " Check").Range("A1").PasteSpecial** 'Copy Headers into newly created *Check* tab where the securities failing the test will be stored'
**For Each Cell In CalcRange
If Not IsError(Cell) Then
If Cell** > 500 Or Cell < -100 Then
Cell.Font.Bold = True
Cell.Interior.ColorIndex = 36
Call Cut_into_Check_Tab
End If
End If
Next Cell
End If
If WshtNames(w) = "Bench OAS Change" Then
.Range(.Cells(1, 1), .Cells(FirstHeaderRow.Row, LastColumn.Column)).Copy
Worksheets(WshtNames(w) & " Check").Range("A1").PasteSpecial 'Copy Headers into newly created *Check* tab where the securities failing the test will be stored'
For Each Cell In CalcRange
If Not IsError(Cell) Then
If Cell > 250 Or Cell < -250 Then
Cell.Font.Bold = True
Cell.Interior.ColorIndex = 36
Call Cut_into_Check_Tab
End If
End If
Next Cell
End If
If WshtNames(w) = "Bench Spread Dur" Then
.Range(.Cells(1, 1), .Cells(FirstHeaderRow.Row, LastColumn.Column)).Copy
Worksheets(WshtNames(w) & " Check").Range("A1").PasteSpecial 'Copy Headers into newly created *Check* tab where the securities failing the test will be stored'
For Each Cell In CalcRange
If Not IsError(Cell) Then
If Cell > 50 Or Cell < 0 Then
Cell.Font.Bold = True
Cell.Interior.ColorIndex = 36
Call Cut_into_Check_Tab
End If
End If
Next Cell
End If
If WshtNames(w) = "Bench Duration" Then
.Range(.Cells(1, 1), .Cells(FirstHeaderRow.Row, LastColumn.Column)).Copy
Worksheets(WshtNames(w) & " Check").Range("A1").PasteSpecial 'Copy Headers into newly created *Check* tab where the securities failing the test will be stored'
For Each Cell In CalcRange
If Not IsError(Cell) Then
If Cell > 50 Or Cell < 0 Then
Cell.Font.Bold = True
Cell.Interior.ColorIndex = 36
Call Cut_into_Check_Tab
End If
End If
Next Cell
End If
If WshtNames(w) = "Bench Convexity" Then
.Range(.Cells(1, 1), .Cells(FirstHeaderRow.Row, LastColumn.Column)).Copy
Worksheets(WshtNames(w) & " Check").Range("A1").PasteSpecial 'Copy Headers into newly created *Check* tab where the securities failing the test will be stored'
For Each Cell In CalcRange
If Not IsError(Cell) Then
If Cell > 20 Or Cell < 0 Then
Cell.Font.Bold = True
Cell.Interior.ColorIndex = 36
Call Cut_into_Check_Tab
End If
End If
Next Cell
End If
End With
Next w
End Sub
Sub Cut_into_Check_Tab()
LRow = get_end_row(FirstHeaderColumn) 'Calls Get_end_Row FUNCTION which finds dynamic last_row under column First Header Column'
Cell.EntireRow.Cut Destination:=Worksheets(WshtNames(w) & " Check").Range("A" & LRow + 1)
End Sub
Function get_end_row(ByVal column_with_data As Long) As Long
Dim last_row As Long
last_row = Worksheets(WshtNames(w) & " Check").Rows.Count
get_end_row = Worksheets(WshtNames(w) & " Check").Cells(last_row, column_with_data).End(xlUp).Row
End Function
Function Destination_Tab_Format()
For w = LBound(WshtNames, 1) To UBound(WshtNames, 1)
wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = WshtNames(w) & " Check"
Next w
End Function
Aucun commentaire:
Enregistrer un commentaire