Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
PROGRESS BAR
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(intS heet).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).Shee ts("Consolidate").Cells(i* ntRow, 16) intCopy8 = Workbooks(L3_L5_Blank_Consolidation_template).Shee ts("Consolidate").Cells(i* ntRow, 17) If intCopy67 = 1 Then ' Set commitments columns to zero Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 7).ClearContents Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).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(currents heet).Cells(intRow, 10) Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 9) _ = dblprevious _ - Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 4) _ - Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 7) _ - Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).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(curr entsheet).Cells(intRow, 9) _ = Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 11) _ - Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).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).Activa te 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).Activa te ' 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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
PROGRESS BAR
see at your other places where you put this question. Dave Peterson responded.
-- Wigi http://www.wimgielis.be = Excel/VBA, soccer and music "Ola2B" wrote: 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(intS heet).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).Shee ts("Consolidate").Cells(iĀ* ntRow, 16) intCopy8 = Workbooks(L3_L5_Blank_Consolidation_template).Shee ts("Consolidate").Cells(iĀ* ntRow, 17) If intCopy67 = 1 Then ' Set commitments columns to zero Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 7).ClearContents Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
PROGRESS BAR
There was a response at another thread, but it wasn't from me.
Wigi wrote: see at your other places where you put this question. Dave Peterson responded. -- Wigi http://www.wimgielis.be = Excel/VBA, soccer and music "Ola2B" wrote: 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(intS heet).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).Shee ts("Consolidate").Cells(iĀ* ntRow, 16) intCopy8 = Workbooks(L3_L5_Blank_Consolidation_template).Shee ts("Consolidate").Cells(iĀ* ntRow, 17) If intCopy67 = 1 Then ' Set commitments columns to zero Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).Cells(intRow, 7).ClearContents Workbooks(LLUpdated_template_filename).Sheets(curr entsheet).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 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Progress bar | Excel Discussion (Misc queries) | |||
Progress Moons | Excel Discussion (Misc queries) | |||
Progress Tax Calculator | Excel Worksheet Functions | |||
Progress to a Target | Charts and Charting in Excel | |||
Progress YTD | Charts and Charting in Excel |