Sub ImportIOs()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
If Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("Basis").Range("B15:Z15"), "Y") = 0 Then
MsgBox ("No basis were selected for Individual Output import. Please check row 15 of sheet 'Basis' and try again."), , "Error"
Exit Sub
End If
Dim MyObject As Object, File As Object, Folder As Object, SubFolders As Object
Dim Path As String, RRPath As String, BaselinePath As String, LiabPath As String, ValDate As String, ValYear As String, StudioNode As String, DiscountMethod As String, Import As String
Dim RowBasis As Range, RowIO As Range, HideColumns As Range, ToFormat As Range
ValDate = Worksheets("Client specific").Cells(6, "B").Value
DiscountMethod = Worksheets("Client specific").Cells(13, "B").Value
Set RowBasis = ThisWorkbook.Worksheets("Basis").Range("B17:Z17")
Set RowIO = ThisWorkbook.Worksheets("Ind Output").Range("A1:KU1")
Set HideColumns = ThisWorkbook.Worksheets("Ind Output").Range("A1:KU3")
If Month(ValDate) = 1 Then
ValYear = Year(ValDate) - 1
Else
ValYear = Year(ValDate)
End If
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set Folder = MyObject.GetFolder("\\abc.com\xxxxxxxxxx\" + Worksheets("Client specific").Cells(5, "B").Value + "\")
Set SubFolders = Folder.SubFolders
For Each SubFolders In SubFolders
If InStr(SubFolders.Name, ValYear) Then
RRPath = SubFolders.Path + "\03-Liabilities\01-ReplicationRun\"
BaselinePath = SubFolders.Path + "\03-Liabilities\02-Baseline\"
LiabPath = SubFolders.Path + "\03-Liabilities\04-OngoingBasis\"
Exit For
End If
Next
For Each Cell In RowBasis.Cells
If Cell.Offset(2, 0).Value = "" Then
StudioNode = ""
Else
StudioNode = Cell.Offset(2, 0).Value & ".xlsx"
End If
Import = Cell.Offset(-2, 0).Value
For Each CellIO In RowIO.Cells
If (Cell = CellIO) And (Not StudioNode = "") And UCase(Import) = "Y" Then
If InStr(StudioNode, "Replication") Or InStr(StudioNode, "RR") Then
Set File = MyObject.GetFolder(RRPath)
ElseIf InStr(StudioNode, "Baseline") Then
Set File = MyObject.GetFolder(BaselinePath)
Else
Set File = MyObject.GetFolder(LiabPath)
End If
For Each File In File.Files
Workbooks.Open File
Set ToFormat = Workbooks(StudioNode).Worksheets("Sheet1").Columns("A")
With ToFormat
.NumberFormat = "General": .Value = .Value
End With
Workbooks(StudioNode).Worksheets("Sheet1").Range("A7", Range("I7").End(xlDown)).Copy
ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Workbooks(StudioNode).Close (False)
Next File
ElseIf (Cell = CellIO) And (StudioNode = "") Then
If (CellIO.Interior.Color = RGB(255, 255, 153) Or CellIO.Interior.Color = RGB(250, 191, 143)) And CellIO.HasFormula = True Then
If (CellIO = "Last Time Basis" Or CellIO = "PBO") Then
ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0) & ":" & CellIO.Offset(2, 14).Address(0, 0)).EntireColumn.Hidden = True
Else
ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0) & ":" & CellIO.Offset(2, 12).Address(0, 0)).EntireColumn.Hidden = True
End If
End If
ThisWorkbook.Worksheets("Basis").Range(Cell.Address(0, 0)).EntireColumn.Hidden = True
End If
Next CellIO
Next Cell
For Each Cell In HideColumns.Cells
If Cell.DisplayFormat.Interior.ColorIndex = 16 Then
Range(Cell.Address(0, 0)).EntireColumn.Hidden = True
End If
Next Cell
ThisWorkbook.Worksheets("Basis").Range("AA:AC").EntireColumn.Hidden = True
On Error GoTo ErrMsg
Set ToFormat = ThisWorkbook.Worksheets("Ind Output").Range("A15", Range("KU15").End(xlDown)).SpecialCells(xlCellTypeConstants)
With ToFormat
.Cells.Interior.Color = RGB(255, 255, 153)
.Cells.Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
.Cells.Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
.Cells.Borders(xlEdgeRight).Color = RGB(0, 0, 0)
.Cells.Borders(xlEdgeTop).Color = RGB(0, 0, 0)
.Cells.Borders(xlInsideVertical).Color = RGB(0, 0, 0)
.Cells.Borders(xlInsideHorizontal).Color = RGB(0, 0, 0)
End With
Cells(1, 1).Select
Exit Sub
ErrMsg:
MsgBox ("No data to display. Please try again."), , "Error"
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
End Sub