vendredi 15 juin 2018

Sub performing tasks individually but not Collectively

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:

  1. Create a new tab based on some array variables
  2. Copy paste some headers from a related tab
  3. 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