O
Ola2B
Can anyone please show me how to add a progress bar to the lengthy
codes below. Please note I currently execute this programme through a
userform.
Many thanks for your help.
Function consolidate_templates()
'
''
Dim i As Integer
Dim j As Integer
Dim CC_2YN As Variant
Dim CC_2_Consolidate As String
Dim Control_workbook As String ' Stores name of this workbook
Dim Blank_Template_Path As String 'Stores path of the blank templates
Dim Blank_Template_filename As String ' Stores blank template filename/
path
Dim Blank_Template_filename2 As String ' Stores blank template
filename/path
Dim Cost_centreLU As String ' Stores cost centre value at Upper Level
Dim Cost_centreLL As String ' Stores cost centre value at Lower Level
Dim Updated_template_path As String 'Stores path of actual monitoring
reports
Dim Updated_template_filename As String 'Stores name and path of this
month's template
Dim LLChange As String ' Used to hold lower level cost centre
Dim LUChange As String ' Used to hold upper level cost centre
Dim Monitoring_Month As String, Previous_Month As String
Dim Previous_file As String, previous_file_shortname As String,
previousfound As Boolean
Dim IncNSO As String, intSheet As Integer, currentsheet As String,
previoussheetfound As Boolean
Dim intRow As Integer, dblprevious As Double, intCopy67 As Integer,
intCopy8 As Integer
Dim signoffcell As String, strPassword As String
Dim Path_4_Consolidation As String
Dim LUConsolidated_path As String
Dim Cons_Level As Variant ' Reads Consolidation level from Worksheet
Dim CLU As Integer ' Level consolidating to
Dim CLL As Integer ' level consolidating from
Dim L3_L5_Blank_Consolidation_template 'Name of blank consolidation
workbook
Dim L3_L5_Consolidation_Template_Path ' Path for
L3_L5_Consolidation_Template_Path
Dim L3_L5_Blank_Consolidation_filename As String ' Path and filename
of blank template
Dim Summary_filename As String ' Name of file to Save Consolidation
Dim Summary_output As String 'Name of Saved COnsolidation file with
path
Dim Flag As Boolean
Dim LLUpdated_template_filename ' Holds name of files to consolidate
Dim Code_list As String ' Range of codes to consolidate
Dim sCCNames As String 'used in added code, holding S/sheet names in
same workbook
Dim sCCDes As String ' Level 2 Descrption List
Dim sDescription As String ' description
Dim sASO As String ' Holds what's in 'Auto Sign Off' cell
Application.Calculate 'Added 8th March 06 - Ola (to ensure filepaths
are correct)
i = 1
j = 0
Control_workbook = ThisWorkbook.Name
Monitoring_Month = Range("Monitoring_month").Value
Previous_Month = Range("PreviousMonth").Value
Cons_Level = Range("Consolidation_Level").Value
IncNSO = Range("IncludeNSO")
If Cons_Level = 2 Then
CLU = 3
Code_list = "L2_Consolidate_List"
sCCDes = "CC2_Description"
signoffcell = "e7"
strPassword = "csmodel" 'Added 21-12-06 by Ola A
ElseIf Cons_Level = 1 Then
CLU = 2
Code_list = "L3_Consolidate_List"
sCCDes = "CC1_Description" 'Added 21-12-06 by Ola A
signoffcell = "H7" '
strPassword = "csforecast" 'Added 21-12-06 by Ola A
ElseIf Cons_Level = 0 Then
CLU = 1
Code_list = "L4_Consolidate_List"
sCCDes = "CC0_Description" 'Added 21-12-06 by Ola A
signoffcell = "H7" 'Added 21-12-06 by Ola A
strPassword = "csforecast" ' added by Ola
Else
MsgBox "Level to consolidate is invalid"
Exit Function
End If
CLL = CLU + 1
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LLChange = ""
' Open L3-L5 blank consolidation template
L3_L5_Blank_Consolidation_template =
Range("L3_L5_Blank_Consolidation_template").Value
L3_L5_Consolidation_Template_Path =
Range("L3_L5_Consolidation_Template_Path").Value
L3_L5_Blank_Consolidation_filename = L3_L5_Consolidation_Template_Path
& L3_L5_Blank_Consolidation_template
CC_2YN = 0
' Find a cost centre to consolidate
' code added to chk if there's any cost centre to consolidate:
Dim k As Integer
Do Until CC_2YN = ""
k = k + 1
CC_2YN = Range(Code_list).Cells(k, 2).Value
If CC_2YN = 1 Then
k = -1
CC_2YN = 0
Exit Do
End If
Loop
If k <> -1 Then
MsgBox "No Cost Centre selected to consolidate!", vbCritical
Exit Function
End If
' added code ends.
Do Until CC_2YN = ""
If CC_2YN = 1 Then
CC_2_Consolidate = Range(Code_list).Cells(j, 1).Value
sDescription = Range(sCCDes).Cells(j, 2).Value
' Find the cost centres position in the main cost centre table
i = find_CC(CC_2_Consolidate, i, CLU)
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
LLChange = Cost_centreLL
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LUChange = Cost_centreLU
' Set up new consolidation workbook
Workbooks(Control_workbook).Activate
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LUConsolidated_path = Range("Template_list").Cells(i, 9).Value
Summary_filename = Cost_centreLU & " " & Monitoring_Month _
& " Monitoring Summary.xls"
Summary_output = LUConsolidated_path & Summary_filename
' On Error GoTo Constmpl_FileMissing
Workbooks.Open Filename:=L3_L5_Blank_Consolidation_filename
sCCNames = "" ' added code, reset sccnames
Do Until Cost_centreLU <> LUChange
' make sure no duplicate cost centre in the same workbook:
If InStr(1, sCCNames, Cost_centreLL) = 0 Then 'added code
Updated_template_filename = ""
LLUpdated_template_filename = ""
Updated_template_path = ""
' Open completed consolidated template
Workbooks(Control_workbook).Activate
Updated_template_filename = Cost_centreLL & " " &
Monitoring_Month _
& " Monitoring Summary.xls"
LLUpdated_template_filename =
Updated_template_filename
Updated_template_path =
Range("Template_list").Cells(i, 8).Value
Updated_template_filename = Updated_template_path &
LLUpdated_template_filename
'On Error GoTo MissingTmpl
Workbooks.Open Filename:=Updated_template_filename,
UpdateLinks:=False
' Code added
' Include non-signed off cost centres if option
selected by user
If IncNSO = "Yes" Then
' If level 2 consolidation then previous month's
consolidation
' workbook will be used to copy previous months
Level 4 data from
previousfound = False
If Cons_Level = 2 And Previous_Month <> "" Then
Previous_file = Updated_template_path &
Cost_centreLL & " " & _
Previous_Month & " Monitoring Summary.xls"
On Error GoTo errNoPreviousFile
Workbooks.Open Filename:=Previous_file,
UpdateLinks:=False
On Error GoTo 0
previousfound = True
previous_file_shortname = ActiveWorkbook.Name
End If
resNoPreviousFile:
On Error GoTo 0
' Loop through each sheet
intSheet = 3
Do Until
Workbooks(LLUpdated_template_filename).Sheets(intSheet).Name = "End"
Windows(LLUpdated_template_filename).Activate
currentsheet = Sheets(intSheet).Name
Sheets(currentsheet).Unprotect
password:=strPassword
If Sheets(currentsheet).Range(signoffcell) =
"" Then
' This cost centre not signed off
Sheets(currentsheet).Range(signoffcell) =
"Auto sign off"
End If
'If Sheets(currentsheet).Range(signoffcell) =
"Auto sign off" Then
' the 'SignOffCell' may have a date as well,
hence the InStr Function:
sASO = Sheets(currentsheet).Range(signoffcell)
If InStr(1, sASO, "Auto sign off") > 1 Then
' Use last month's (or budget) projections
previoussheetfound = False
If Cons_Level = 2 Then
' Previous month / budget data used
for Level 4 cost centres
If previousfound Then
' Previous month's file is
available
Workbooks(previous_file_shortname).Activate
On Error GoTo errNoPreviousSheet
Sheets(currentsheet).Select
On Error GoTo 0
If
Sheets(currentsheet).Range(signoffcell) <> "" Then _
previoussheetfound = True
End If
resNoPreviousSheet:
On Error GoTo 0
For intRow = 17 To 49
intCopy67 =
Workbooks(L3_L5_Blank_Consolidation_template).Sheets("Consolidate").Cells(intRow,
16)
intCopy8 =
Workbooks(L3_L5_Blank_Consolidation_template).Sheets("Consolidate").Cells(intRow,
17)
If intCopy67 = 1 Then
' Set commitments columns to
zero
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
7).ClearContents
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
8).ClearContents
End If
If intCopy8 = 1 Then
If previoussheetfound Then
' Previous month's sheet
is available
' Set projection for rest
of year to be difference between
' full year projection
last month and actual + commitments
dblprevious =
Workbooks(previous_file_shortname).Sheets(currentsheet).Cells(intRow,
10)
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
9) _
= dblprevious _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
4) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
7) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
8)
Else
' Previous month's sheet
(or file) is not available
' Set projection for rest
of year to be difference between
' budget profile to date
and full year budget
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
9) _
=
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
11) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
5)
End If
End If
Next intRow
End If
End If
intSheet = intSheet + 1
Loop
' Close last month's file
' If InStr(1, previous_file_shortname, "JXDA") > 0 Then Stop
If previousfound Then
Workbooks(previous_file_shortname).Close SaveChanges:=False
' If InStr(1, LLUpdated_template_filename, "JXDA") > 0 Then
Stop
Windows(LLUpdated_template_filename).Activate
End If
' Added code ends
' Select Consolidate sheet and copy and paste values
to Consolidation template
Sheets("Consolidate").Select
Calculate
Cells.Select
Selection.Copy
Windows(L3_L5_Blank_Consolidation_template).Activate
Sheets(3).Select
Sheets.Add
'Windows(LLUpdated_template_filename).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
' Change sheet name to L3-L5 cost centre
Sheets(3).Select
Sheets(3).Name = Cost_centreLL
Range("B9").Value = Cost_centreLL
Range("J9").Value = sDescription
With ActiveWindow
.Zoom = 50
.DisplayHeadings = False
.DisplayZeros = False
.DisplayGridlines = False
Range("B16").Select
ActiveWindow.FreezePanes = True
End With
' Protect worksheet
ActiveSheet.Protect password:="csforecast",
DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks(LLUpdated_template_filename).Close
SaveChanges:=False 'SaveChanges parameter
End If 'added code
sCCNames = sCCNames & "," & Cost_centreLL 'added code
Workbooks(Control_workbook).Activate
' Increment counter to look at next cost centre
i = find_next_cost_centre(i, Cost_centreLL, CLL)
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
Loop
Application.DisplayAlerts = False ' added code
' Save blank template in appropriate folder with new name
Windows(L3_L5_Blank_Consolidation_template).Activate
' Save consolidation file - overwriting any old files
' Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
Summary_output, FileFormat _
:=xlNormal, password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks(Summary_filename).Close
Workbooks(Control_workbook).Activate
End If
j = j + 1
CC_2YN = Range(Code_list).Cells(j, 2).Value
Loop
Application.DisplayAlerts = True 'added code
Exit Function
errNoPreviousFile:
' No consolidation file from previous month
Resume resNoPreviousFile
errNoPreviousSheet:
' No corresponding sheet in previous month's file
Resume resNoPreviousSheet
' Added code ends
Constmpl_FileMissing:
MsgBox "Workbook " & L3_L5_Blank_Consolidation_filename & "
could " _
& " not be found. Check path and filename.", , "Blank
template missing"
Exit Function
MissingTmpl:
MsgBox "Workbook " & Updated_template_filename & " could " _
& " not be found. Check path and filename.", ,
"Completed template missing"
Exit Function
End Function
Function find_next_cost_centre(i As Integer, Cost_centreLL As String,
CLL As Integer) As Integer
Dim CCLL As String
CCLL = Cost_centreLL
Do Until Cost_centreLL <> CCLL Or Cost_centreLL = ""
i = i + 1
Cost_centreLL = Range("Template_list").Cells(i, CLL)
find_next_cost_centre = i
Loop
End Function
Function find_CC(CC_2_Consolidate As String, i As Integer, CLU As
Integer) As Integer
Dim Test As String
Dim Test1 As String
i = 0
Test = ""
Do Until Test = CC_2_Consolidate
i = i + 1
Test = Range("Template_List").Cells(i, CLU).Value
Loop
find_CC = i
End Function
codes below. Please note I currently execute this programme through a
userform.
Many thanks for your help.
Function consolidate_templates()
'
''
Dim i As Integer
Dim j As Integer
Dim CC_2YN As Variant
Dim CC_2_Consolidate As String
Dim Control_workbook As String ' Stores name of this workbook
Dim Blank_Template_Path As String 'Stores path of the blank templates
Dim Blank_Template_filename As String ' Stores blank template filename/
path
Dim Blank_Template_filename2 As String ' Stores blank template
filename/path
Dim Cost_centreLU As String ' Stores cost centre value at Upper Level
Dim Cost_centreLL As String ' Stores cost centre value at Lower Level
Dim Updated_template_path As String 'Stores path of actual monitoring
reports
Dim Updated_template_filename As String 'Stores name and path of this
month's template
Dim LLChange As String ' Used to hold lower level cost centre
Dim LUChange As String ' Used to hold upper level cost centre
Dim Monitoring_Month As String, Previous_Month As String
Dim Previous_file As String, previous_file_shortname As String,
previousfound As Boolean
Dim IncNSO As String, intSheet As Integer, currentsheet As String,
previoussheetfound As Boolean
Dim intRow As Integer, dblprevious As Double, intCopy67 As Integer,
intCopy8 As Integer
Dim signoffcell As String, strPassword As String
Dim Path_4_Consolidation As String
Dim LUConsolidated_path As String
Dim Cons_Level As Variant ' Reads Consolidation level from Worksheet
Dim CLU As Integer ' Level consolidating to
Dim CLL As Integer ' level consolidating from
Dim L3_L5_Blank_Consolidation_template 'Name of blank consolidation
workbook
Dim L3_L5_Consolidation_Template_Path ' Path for
L3_L5_Consolidation_Template_Path
Dim L3_L5_Blank_Consolidation_filename As String ' Path and filename
of blank template
Dim Summary_filename As String ' Name of file to Save Consolidation
Dim Summary_output As String 'Name of Saved COnsolidation file with
path
Dim Flag As Boolean
Dim LLUpdated_template_filename ' Holds name of files to consolidate
Dim Code_list As String ' Range of codes to consolidate
Dim sCCNames As String 'used in added code, holding S/sheet names in
same workbook
Dim sCCDes As String ' Level 2 Descrption List
Dim sDescription As String ' description
Dim sASO As String ' Holds what's in 'Auto Sign Off' cell
Application.Calculate 'Added 8th March 06 - Ola (to ensure filepaths
are correct)
i = 1
j = 0
Control_workbook = ThisWorkbook.Name
Monitoring_Month = Range("Monitoring_month").Value
Previous_Month = Range("PreviousMonth").Value
Cons_Level = Range("Consolidation_Level").Value
IncNSO = Range("IncludeNSO")
If Cons_Level = 2 Then
CLU = 3
Code_list = "L2_Consolidate_List"
sCCDes = "CC2_Description"
signoffcell = "e7"
strPassword = "csmodel" 'Added 21-12-06 by Ola A
ElseIf Cons_Level = 1 Then
CLU = 2
Code_list = "L3_Consolidate_List"
sCCDes = "CC1_Description" 'Added 21-12-06 by Ola A
signoffcell = "H7" '
strPassword = "csforecast" 'Added 21-12-06 by Ola A
ElseIf Cons_Level = 0 Then
CLU = 1
Code_list = "L4_Consolidate_List"
sCCDes = "CC0_Description" 'Added 21-12-06 by Ola A
signoffcell = "H7" 'Added 21-12-06 by Ola A
strPassword = "csforecast" ' added by Ola
Else
MsgBox "Level to consolidate is invalid"
Exit Function
End If
CLL = CLU + 1
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LLChange = ""
' Open L3-L5 blank consolidation template
L3_L5_Blank_Consolidation_template =
Range("L3_L5_Blank_Consolidation_template").Value
L3_L5_Consolidation_Template_Path =
Range("L3_L5_Consolidation_Template_Path").Value
L3_L5_Blank_Consolidation_filename = L3_L5_Consolidation_Template_Path
& L3_L5_Blank_Consolidation_template
CC_2YN = 0
' Find a cost centre to consolidate
' code added to chk if there's any cost centre to consolidate:
Dim k As Integer
Do Until CC_2YN = ""
k = k + 1
CC_2YN = Range(Code_list).Cells(k, 2).Value
If CC_2YN = 1 Then
k = -1
CC_2YN = 0
Exit Do
End If
Loop
If k <> -1 Then
MsgBox "No Cost Centre selected to consolidate!", vbCritical
Exit Function
End If
' added code ends.
Do Until CC_2YN = ""
If CC_2YN = 1 Then
CC_2_Consolidate = Range(Code_list).Cells(j, 1).Value
sDescription = Range(sCCDes).Cells(j, 2).Value
' Find the cost centres position in the main cost centre table
i = find_CC(CC_2_Consolidate, i, CLU)
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
LLChange = Cost_centreLL
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LUChange = Cost_centreLU
' Set up new consolidation workbook
Workbooks(Control_workbook).Activate
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
LUConsolidated_path = Range("Template_list").Cells(i, 9).Value
Summary_filename = Cost_centreLU & " " & Monitoring_Month _
& " Monitoring Summary.xls"
Summary_output = LUConsolidated_path & Summary_filename
' On Error GoTo Constmpl_FileMissing
Workbooks.Open Filename:=L3_L5_Blank_Consolidation_filename
sCCNames = "" ' added code, reset sccnames
Do Until Cost_centreLU <> LUChange
' make sure no duplicate cost centre in the same workbook:
If InStr(1, sCCNames, Cost_centreLL) = 0 Then 'added code
Updated_template_filename = ""
LLUpdated_template_filename = ""
Updated_template_path = ""
' Open completed consolidated template
Workbooks(Control_workbook).Activate
Updated_template_filename = Cost_centreLL & " " &
Monitoring_Month _
& " Monitoring Summary.xls"
LLUpdated_template_filename =
Updated_template_filename
Updated_template_path =
Range("Template_list").Cells(i, 8).Value
Updated_template_filename = Updated_template_path &
LLUpdated_template_filename
'On Error GoTo MissingTmpl
Workbooks.Open Filename:=Updated_template_filename,
UpdateLinks:=False
' Code added
' Include non-signed off cost centres if option
selected by user
If IncNSO = "Yes" Then
' If level 2 consolidation then previous month's
consolidation
' workbook will be used to copy previous months
Level 4 data from
previousfound = False
If Cons_Level = 2 And Previous_Month <> "" Then
Previous_file = Updated_template_path &
Cost_centreLL & " " & _
Previous_Month & " Monitoring Summary.xls"
On Error GoTo errNoPreviousFile
Workbooks.Open Filename:=Previous_file,
UpdateLinks:=False
On Error GoTo 0
previousfound = True
previous_file_shortname = ActiveWorkbook.Name
End If
resNoPreviousFile:
On Error GoTo 0
' Loop through each sheet
intSheet = 3
Do Until
Workbooks(LLUpdated_template_filename).Sheets(intSheet).Name = "End"
Windows(LLUpdated_template_filename).Activate
currentsheet = Sheets(intSheet).Name
Sheets(currentsheet).Unprotect
password:=strPassword
If Sheets(currentsheet).Range(signoffcell) =
"" Then
' This cost centre not signed off
Sheets(currentsheet).Range(signoffcell) =
"Auto sign off"
End If
'If Sheets(currentsheet).Range(signoffcell) =
"Auto sign off" Then
' the 'SignOffCell' may have a date as well,
hence the InStr Function:
sASO = Sheets(currentsheet).Range(signoffcell)
If InStr(1, sASO, "Auto sign off") > 1 Then
' Use last month's (or budget) projections
previoussheetfound = False
If Cons_Level = 2 Then
' Previous month / budget data used
for Level 4 cost centres
If previousfound Then
' Previous month's file is
available
Workbooks(previous_file_shortname).Activate
On Error GoTo errNoPreviousSheet
Sheets(currentsheet).Select
On Error GoTo 0
If
Sheets(currentsheet).Range(signoffcell) <> "" Then _
previoussheetfound = True
End If
resNoPreviousSheet:
On Error GoTo 0
For intRow = 17 To 49
intCopy67 =
Workbooks(L3_L5_Blank_Consolidation_template).Sheets("Consolidate").Cells(intRow,
16)
intCopy8 =
Workbooks(L3_L5_Blank_Consolidation_template).Sheets("Consolidate").Cells(intRow,
17)
If intCopy67 = 1 Then
' Set commitments columns to
zero
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
7).ClearContents
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
8).ClearContents
End If
If intCopy8 = 1 Then
If previoussheetfound Then
' Previous month's sheet
is available
' Set projection for rest
of year to be difference between
' full year projection
last month and actual + commitments
dblprevious =
Workbooks(previous_file_shortname).Sheets(currentsheet).Cells(intRow,
10)
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
9) _
= dblprevious _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
4) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
7) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
8)
Else
' Previous month's sheet
(or file) is not available
' Set projection for rest
of year to be difference between
' budget profile to date
and full year budget
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
9) _
=
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
11) _
-
Workbooks(LLUpdated_template_filename).Sheets(currentsheet).Cells(intRow,
5)
End If
End If
Next intRow
End If
End If
intSheet = intSheet + 1
Loop
' Close last month's file
' If InStr(1, previous_file_shortname, "JXDA") > 0 Then Stop
If previousfound Then
Workbooks(previous_file_shortname).Close SaveChanges:=False
' If InStr(1, LLUpdated_template_filename, "JXDA") > 0 Then
Stop
Windows(LLUpdated_template_filename).Activate
End If
' Added code ends
' Select Consolidate sheet and copy and paste values
to Consolidation template
Sheets("Consolidate").Select
Calculate
Cells.Select
Selection.Copy
Windows(L3_L5_Blank_Consolidation_template).Activate
Sheets(3).Select
Sheets.Add
'Windows(LLUpdated_template_filename).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
' Change sheet name to L3-L5 cost centre
Sheets(3).Select
Sheets(3).Name = Cost_centreLL
Range("B9").Value = Cost_centreLL
Range("J9").Value = sDescription
With ActiveWindow
.Zoom = 50
.DisplayHeadings = False
.DisplayZeros = False
.DisplayGridlines = False
Range("B16").Select
ActiveWindow.FreezePanes = True
End With
' Protect worksheet
ActiveSheet.Protect password:="csforecast",
DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks(LLUpdated_template_filename).Close
SaveChanges:=False 'SaveChanges parameter
End If 'added code
sCCNames = sCCNames & "," & Cost_centreLL 'added code
Workbooks(Control_workbook).Activate
' Increment counter to look at next cost centre
i = find_next_cost_centre(i, Cost_centreLL, CLL)
Cost_centreLU = Range("Template_list").Cells(i, CLU).Value
Cost_centreLL = Range("Template_list").Cells(i, CLL).Value
Loop
Application.DisplayAlerts = False ' added code
' Save blank template in appropriate folder with new name
Windows(L3_L5_Blank_Consolidation_template).Activate
' Save consolidation file - overwriting any old files
' Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
Summary_output, FileFormat _
:=xlNormal, password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks(Summary_filename).Close
Workbooks(Control_workbook).Activate
End If
j = j + 1
CC_2YN = Range(Code_list).Cells(j, 2).Value
Loop
Application.DisplayAlerts = True 'added code
Exit Function
errNoPreviousFile:
' No consolidation file from previous month
Resume resNoPreviousFile
errNoPreviousSheet:
' No corresponding sheet in previous month's file
Resume resNoPreviousSheet
' Added code ends
Constmpl_FileMissing:
MsgBox "Workbook " & L3_L5_Blank_Consolidation_filename & "
could " _
& " not be found. Check path and filename.", , "Blank
template missing"
Exit Function
MissingTmpl:
MsgBox "Workbook " & Updated_template_filename & " could " _
& " not be found. Check path and filename.", ,
"Completed template missing"
Exit Function
End Function
Function find_next_cost_centre(i As Integer, Cost_centreLL As String,
CLL As Integer) As Integer
Dim CCLL As String
CCLL = Cost_centreLL
Do Until Cost_centreLL <> CCLL Or Cost_centreLL = ""
i = i + 1
Cost_centreLL = Range("Template_list").Cells(i, CLL)
find_next_cost_centre = i
Loop
End Function
Function find_CC(CC_2_Consolidate As String, i As Integer, CLU As
Integer) As Integer
Dim Test As String
Dim Test1 As String
i = 0
Test = ""
Do Until Test = CC_2_Consolidate
i = i + 1
Test = Range("Template_List").Cells(i, CLU).Value
Loop
find_CC = i
End Function