Sub consolidate()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.AskToUpdateLinks = False
'Variables related to main page
Dim FileSH As Worksheet
Set FileSH = Worksheets("File name and Paths")
Dim MpLrow As Double 'Mp = mainpage
MpLrow = FileSH.Range("B1048576").End(xlUp).Row
Dim MPR As Double 'MP=Main page, R=Row
Dim FileLocation As String
Dim CurrFile As Workbook
Dim SelKW As String
SelKW = Sheets("Main View").Range("C2").Value
'----------------------------------------------------
'Variables related to Weekly KPIs
Dim wKPI As Workbook
Dim wKPIname As String
Dim wKPI_Lrow As Double
Dim wKPI_Lcol As Double
Dim wKPIr As Double
Dim wKPIc As Double
Dim wKPIsh As Worksheet
Dim Arr As Variant
'----------------------------------------------------
'Variables related to Consolidated KPI
Dim cKPI As Workbook
Dim cKPIlocation As Variant
Dim cKPI_Lrow As Double
Dim cKPI_Lcol As Double
Dim cKPIsh As Worksheet
'Check if KPIs are loaded
If FileSH.Range("A" & Rows.Count).End(xlUp).Row > 1 Then
'Open Consolidate KPI
cKPIlocation = Application.GetOpenFilename(Title:="Select Master KPI template")
If cKPIlocation <> False Then
Set cKPI = Workbooks.Open(cKPIlocation, UpdateLinks:=0)
'----------------------------------------------------
'Delete old data if anything populated previously
For Each cKPIsh In cKPI.Worksheets
If (cKPIsh.Name <> "Summary" And cKPIsh.Name <> "Project timeline") Then
cKPIsh.Rows("8:1048576").EntireRow.Clear
End If
Next cKPIsh
'----------------------------------------------------
'Progress bar intilalisation
Call OpenStatusBar
'Loop through Main page allocate filelocation and open
For MPR = 2 To MpLrow
FileLocation = FileSH.Cells(MPR, 3)
Set wKPI = Workbooks.Open(FileLocation)
wKPIname = FileSH.Cells(MPR, 2).Value
'Loop through each sheet in consolidate KPI
For Each cKPIsh In cKPI.Worksheets
If (cKPIsh.Name <> "Summary" And cKPIsh.Name <> "Project timeline") Then
cKPI_Lcol = cKPIsh.Range("XFD7").End(xlToLeft).Column
For Each wKPIsh In wKPI.Worksheets
If cKPIsh.Name = wKPIsh.Name Then
'Declare Last row variables
wKPI_Lrow = wKPIsh.Range("B1048576").End(xlUp).Row
wKPI_Lcol = wKPIsh.Range("XFD7").End(xlToLeft).Column
If wKPI_Lrow > 7 Then
wKPIsh.Range(wKPIsh.Cells(8, 2), wKPIsh.Cells(wKPI_Lrow, wKPI_Lcol)).Copy
cKPI_Lrow1 = cKPIsh.Range("B1048576").End(xlUp).Row + 1
cKPIsh.Range(cKPIsh.Cells(cKPI_Lrow1, 2), cKPIsh.Cells(cKPI_Lrow1, cKPI_Lcol)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
cKPI_Lrow = cKPIsh.Range("B1048576").End(xlUp).Row
cKPIsh.Range(cKPIsh.Cells(cKPI_Lrow1, 1), cKPIsh.Cells(cKPI_Lrow, 1)).Value = wKPIname
End If
End If
Next wKPIsh
cKPIsh.Range("A7").CurrentRegion.Borders.LineStyle = xlContinuous
cKPIsh.Range("A7").CurrentRegion.Borders.Color = RGB(191, 191, 191)
End If
If cKPIsh.Name = "Summary" Then
cKPIsh.Shapes("Title").TextFrame.Characters.Text = "Master EE KPI Pack" & vbNewLine & " Released on : " & SelKW
'cKPIsh.Range("J3").Value = SelKW
Else
cKPIsh.Shapes("Title").TextFrame.Characters.Text = cKPIsh.Name & vbNewLine & "(Data Extracted on : " & SelKW & ")"
End If
Next cKPIsh
wKPI.Close False
DoEvents
Call StartProgress(MPR, MpLrow)
Next MPR
cKPI.Worksheets("Summary").Activate
Else
'do below when work done
Unload StatusBar
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End If
'do below when Master KPI selection cancelled
Unload StatusBar
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
'If no KPIs loaded then do below
Else
MsgBox ("No KPIs are loaded")
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End If
End Sub