I am experiencing a
Run Time Error 1004 Method 'Range' of object '_Global' failed
error when the following code is executed
I have used this code in a previosu version of the file with no problems, but it is only since updating for a refined process that it now occurs.
Strangely, when I click on 'End' when the error dialog box appears, the file then gets saved.
Attached is the full project that the code sits in. It's not quite finished yet so still some tidying up to do but feedback on where this could be going wrong would be hugely appreciated!
Run Time Error 1004 Method 'Range' of object '_Global' failed
error when the following code is executed
Code:
wbLDAReturn.SaveAs Filename:=strFilePathName, FileFormat:=56Strangely, when I click on 'End' when the error dialog box appears, the file then gets saved.
Attached is the full project that the code sits in. It's not quite finished yet so still some tidying up to do but feedback on where this could be going wrong would be hugely appreciated!
Code:
Option Explicit
Public strDataFolder As String
Public strNetworkFolder As String
Public strDesktopFolder As String
Public strLDAReturnTemplateFolder As String
Public rngLDG As Range
Public wbLDAReturnProcess As Workbook
Public wbLDAReturn As Workbook
Public objFSO As Object
Public dtDate As Date
Public strDate As String
Public strYear As String
Public strPeriod As String
Public rngBrand As Range
Public strBrandSelection As String
Public strLDG As String
Public strRegion As String
Public strHRISDataFile As String
Public strPriorLDAReturnDataFile As String
Public strBudgetDataFile As String
Public strLloydsBudgetDataFile As String
Public strHalifaxBudgetDataFile As String
Public strBoSBudgetDataFile As String
Public strLDAReturnFile As String
Public strAttritionDataFile As String
Public boolFileMissing As Boolean
Public rngHRISData As Range
Public rngBranchStructureData As Range
Public rngPriorLDGMovementData As Range
Public rngPriorInflowData As Range
Public rngAttritionData As Range
Public rngBudgetData As Range
Public rngLDGMovementStart As Range
Public rngHRISDataStart As Range
Public rngAtrritionRoleOffsetStart As Range
Public rngAttritionDataStart As Range
Public rngPriorLDGMovementStart As Range
Public rngPriorInflowStart As Range
Public rngGroupStructureStart As Range
Public rngLDGMovement As Range
Public rngInflow As Range
Public intRowCount As Integer
Public strPriorType As String
Public intPriorType As Integer
Public intPriorRole As Integer
Public intPriorBranchName As Integer
Public intPriorNotes As Integer
Public intLDGMovementBranchName As Integer
Public intRole As Integer
Public intType As Integer
Public intDate As Integer
Public intNotes As Integer
Public rngLDGMovementData As Range
Public boolSummaryData As Boolean
Public wsLDGMovement As Worksheet
Public wsInflow As Worksheet
Public wsPriorLDGMovement As Worksheet
Public wsPriorInflow As Worksheet
Sub LDAReturns()
Dim intMonth As Integer
Dim mbSummaryData
Dim mbSummaryDataConfirm
'check if a month has been selected
If Range("Procedure_Month") = "" Then
MsgBox ("Select a month from the drop-down box in cell " & Replace(Range("Procedure_Month").Address, "$", "")), vbExclamation, "Error"
Range("Procedure_Month").Select
Exit Sub
Else
End If
'check if a CB has been selected
If Range("Procedure_Brand") = "" Then
MsgBox ("Select a Brand from the drop-down list in cell " & Replace(Range("Procedure_Brand").Address, "$", "")), vbExclamation, "Error"
Range("Procedure_Brand").Select
Exit Sub
Else
End If
strBrandSelection = Range("Procedure_Brand")
mbSummaryData = MsgBox("Do you want to create a 'LDA Return Summary Data' file for use in the Glide Path compilation process?", vbYesNo, "LDA Return Summary Data")
'check which CB has been selected
If mbSummaryData = vbYes Then
If strBrandSelection = "All" Then
boolSummaryData = True
Else
mbSummaryDataConfirm = MsgBox("WARNING!" & vbCr & vbCr & _
"As the LDA Returns for " & strBrandSelection & " has been selected, the 'LDA Return Summary' file will only contain data from " & strBrandSelection & "." & vbCr & vbCr & _
"To run the LDA Return process for both CB's click 'Cancel' and start the process again selecting 'Both' in cell " & Replace(Range("Procedure_Brand").Address, "$", "") & vbCr & vbCr & _
"Clicking 'OK' will continue the process AND create a 'LDA Return Summary' file containing data from the selelcted CB only.", vbOKCancel, "Continue?")
If mbSummaryDataConfirm = vbOK Then
boolSummaryData = True
Else
boolSummaryData = False
End If
End If
Else
boolSummaryData = False
MsgBox ("Ensure that the 'LDA Return Summary' process is run after this process has finished"), vbInformation, "Run LDA Return Summary Process"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
'create folder names from date
dtDate = "1 " & Range("Procedure_Month")
strYear = Year(dtDate)
intMonth = Month(dtDate)
strPeriod = intMonth & " - " & Format(dtDate, "mmm yy")
strDate = Format(dtDate, "mmm yy")
dtDate = "1/" & Month(dtDate) + 1 & "/" & strYear
CheckFilesExist
'if any required files were missing from above sub, then exit
If boolFileMissing = True Then
Set objFSO = Nothing
Application.StatusBar = False
Exit Sub
Else
End If
Application.ScreenUpdating = False
CreateFolders
'copy the template to the desktop folder created
CopyLDAReturnTemplate
'assign object to file
Set wbLDAReturnProcess = ActiveWorkbook
GetHRISData
GetBudgetData
GetPriorLDAReturnData
GetAttritionData
CreateLDAReturns
'if the LDA Return Data summary file uis required
If boolSummaryData = True Then
Sheets("LDG Movement").Select
ActiveWorkbook.Names.Add Name:="LDGMovement_AllData", RefersTo:=Worksheets("LDG Movement").Range(Range("LDGMovement_Start"), Range("LDGMovement_Start").Offset(5000, 16))
Sheets("Inflow").Select
ActiveWorkbook.Names.Add Name:="Inflow_AllData", RefersTo:=Worksheets("Inflow").Range(Range("inflow_Start"), Range("Inflow_Start").Offset(5000, 12))
SaveGlidePathDataFile
Else
End If
CopyToPublicFolder
CopyToArchive
Call Shell("CACLS ""\\Global.lloydstsb.com\File\ResourcePlanningControl\Shared\Projects\Public Folder\LDA Returns"" /t /g ""Authenticated Users"":F /e")
Set objFSO = Nothing
'clear the data sheets
rngHRISData.ClearContents
rngBranchStructureData.ClearContents
Range(Range("GroupData_Start"), Range("GroupData_Start").End(xlDown).Offset(0, 3)).ClearContents
rngPriorLDGMovementData.ClearContents
rngPriorInflowData.ClearContents
Range(rngAttritionDataStart, rngAttritionDataStart.End(xlDown).Offset(0, 218)).ClearContents
Range(rngAtrritionRoleOffsetStart, rngAtrritionRoleOffsetStart.End(xlDown).Offset(0, 1)).ClearContents
rngBudgetData.ClearContents
If boolSummaryData = True Then
Range(Range("LDGMovement_Start"), Range("LDGMovement_Start").End(xlDown).Offset(0, 15)).ClearContents
Range(wbLDAReturnProcess.Sheets("Inflow").Range("Inflow_Start"), wbLDAReturnProcess.Sheets("Inflow").Range("Inflow_Start").Offset(0, 11).End(xlDown)).ClearContents
Else
End If
Sheets("Procedure").Select
Range("Procedure_Month") = ""
Range("Procedure_CB") = ""
Set rngLDGMovementStart = Nothing
Set rngInflow = Nothing
Set rngHRISData = Nothing
Set rngBranchStructureData = Nothing
Set rngPriorLDGMovementData = Nothing
Set rngPriorInflowData = Nothing
Set rngAttritionData = Nothing
Set rngBudgetData = Nothing
Set rngLDGMovementStart = Nothing
Set rngHRISDataStart = Nothing
Set rngAttritionDataStart = Nothing
Set rngPriorLDGMovementStart = Nothing
Set rngPriorInflowStart = Nothing
Set rngLDGMovementData = Nothing
Set wbLDAReturnProcess = Nothing
Application.ScreenUpdating = True
MsgBox ("The LDA Return files for the selections made have been created"), vbInformation, "LDA Returns Created"
End Sub
Sub CheckFilesExist()
Application.StatusBar = "Checking the required files are available"
'assign folder name
strDataFolder = "\\Global.lloydstsb.com\file\ResourcePlanningControl\shared\ResourcePlanningControl\FTE Control\Common Files\Outputs\"
'assign file name to look for
strHRISDataFile = strDataFolder & "Structure & Outputs\LDA Returns\" & strYear & "\LDA Returns HRIS Data " & strDate & ".xlsb"
'if missing then alert user and exit
If objFSO.fileexists(strHRISDataFile) Then
boolFileMissing = False
Else
MsgBox ("The HRIS Data file for " & strDate & " has not been saved." & vbCr & vbCr & _
"Open the 'Structures & Outputs' file and run the process to establish and save the required file"), vbExclamation, "File Not Saved"
boolFileMissing = True
Exit Sub
End If
strPriorLDAReturnDataFile = strDataFolder & "LDA Returns\LDA Returns\" & strYear & "\LDA Returns " & strDate & ".xlsb"
If objFSO.fileexists(strPriorLDAReturnDataFile) Then
boolFileMissing = False
Else
MsgBox ("The prior period LDA Return data file for " & strDate & " has not been saved." & vbCr & vbCr & _
"Open the 'Compile LDA Return Data' file and run the process to establish and save the required file"), vbExclamation, "File Not Saved"
boolFileMissing = True
Exit Sub
End If
Set rngBrand = Range("Data_BrandStart")
If strBrandSelection = "All" Then
Do Until rngBrand = ""
strBudgetDataFile = strDataFolder & "Budget\" & rngBrand & " Budget.xlsb"
If objFSO.fileexists(strBudgetDataFile) Then
boolFileMissing = False
Else
MsgBox ("The " & strBrandSelection & " Budget file is not available as follows - ." & vbCr & vbCr & _
strBudgetDataFile & vbCr & vbCr & _
"Ensure the " & strBrandSelection & " Budget file is saved as above and run the process again"), vbExclamation, "Budget File Not Available"
boolFileMissing = True
Exit Sub
End If
Set rngBrand = rngBrand.Offset(1, 0)
Loop
Else
strBudgetDataFile = strDataFolder & "Budget\" & strBrandSelection & " Budget.xlsb"
If objFSO.fileexists(strBudgetDataFile) Then
boolFileMissing = False
Else
MsgBox ("The " & strBrandSelection & "Budget file is not available as follows - ." & vbCr & vbCr & _
strBudgetDataFile & vbCr & vbCr & _
"Ensure the " & strBrandSelection & " Budget file is saved as above and run the process again"), vbExclamation, "Budget File Not Available"
boolFileMissing = True
Exit Sub
End If
End If
strAttritionDataFile = strDataFolder & "Attrition Rates\Attrition Rates.xlsb"
If objFSO.fileexists(strAttritionDataFile) Then
boolFileMissing = False
Else
MsgBox ("The Attrition Rates file is not available as follows - ." & vbCr & vbCr & _
strAttritionDataFile & vbCr & vbCr & _
"Ensure the Attrition Rates file is saved as above and run the process again"), vbExclamation, "Attrition File Not Available"
boolFileMissing = True
Exit Sub
End If
strLDAReturnFile = "\\Global.lloydstsb.com\file\ResourcePlanningControl\shared\ResourcePlanningControl\FTE Control\Common Files\Production Files\LDA Returns\LDA Return Template.xls"
If objFSO.fileexists(strLDAReturnFile) Then
boolFileMissing = False
Else
MsgBox ("The LDA Return Template file is not available as follows - ." & vbCr & vbCr & _
strLDAReturnFile & vbCr & vbCr & _
"Ensure the LDA Return Template file is saved as above and run the process again"), vbExclamation, "LDA Return Template File Not Available"
boolFileMissing = True
Exit Sub
End If
End Sub
Sub CreateFolders()
Dim rngBrand As Range
Dim rngRegion As Range
Dim strBrandSelectionFolder As String
Dim strRegionFolder As String
Application.StatusBar = "Checking/creating required Desktop folders"
'create desktop folders
'assign root folder name
strDesktopFolder = "C:\Documents and Settings\" & Environ("username") & "\Desktop\"
'create folders where required
strDesktopFolder = strDesktopFolder & "LDA Returns"
strLDAReturnTemplateFolder = strDesktopFolder
If objFSO.folderexists(strDesktopFolder) Then
Else
objFSO.createfolder (strDesktopFolder)
End If
strDesktopFolder = strDesktopFolder & "\Issued"
If objFSO.folderexists(strDesktopFolder) Then
Else
objFSO.createfolder (strDesktopFolder)
End If
If strBrandSelection = "All" Then
Set rngBrand = Range("Data_BrandStart")
Do Until rngBrand = ""
If objFSO.folderexists(strDesktopFolder & "\" & rngBrand) Then
Else
objFSO.createfolder (strDesktopFolder & "\" & rngBrand)
End If
Set rngRegion = Range("Data_" & rngBrand & "RegionStart")
Do Until rngRegion = ""
strRegionFolder = rngRegion
If objFSO.folderexists(strDesktopFolder & "\" & rngBrand & "\" & strRegionFolder) Then
Else
objFSO.createfolder (strDesktopFolder & "\" & rngBrand & "\" & strRegionFolder)
End If
Set rngRegion = rngRegion.Offset(1, 0)
Loop
Set rngBrand = rngBrand.Offset(1, 0)
Loop
Else
If objFSO.folderexists(strDesktopFolder & "\" & strBrandSelection) Then
Else
objFSO.createfolder (strDesktopFolder & "\" & strBrandSelection)
End If
Set rngRegion = Range("Data_" & strBrandSelection & "Region")
Do Until rngRegion = ""
strRegionFolder = rngRegion
If objFSO.folderexists(strDesktopFolder & "\" & strBrandSelection & "\" & strRegionFolder) Then
Else
objFSO.createfolder (strDesktopFolder & "\" & strBrandSelection & "\" & strRegionFolder)
End If
Set rngRegion = rngRegion.Offset(1, 0)
Loop
End If
Application.StatusBar = "Checking/creating required Network folders"
'create network folders where required
If strBrandSelection = "All" Then
Set rngBrand = Range("Data_BrandStart")
Do Until rngBrand = ""
strNetworkFolder = "\\global.lloydstsb.com\FILE\ResourcePlanningControl\Shared\ResourcePlanningControl\FTE Control\"
If rngBrand = "Halifax" Then
strNetworkFolder = strNetworkFolder & rngBrand & " Community Bank\Outputs\LDA Returns\" & strYear
Else
strNetworkFolder = strNetworkFolder & rngBrand & " Community Bank\LDA Returns\" & strYear
End If
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
strNetworkFolder = strNetworkFolder & "\" & strPeriod
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
strNetworkFolder = strNetworkFolder & "\Issued"
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
Set rngBrand = rngBrand.Offset(1, 0)
Loop
Else
strNetworkFolder = "\\global.lloydstsb.com\FILE\ResourcePlanningControl\Shared\ResourcePlanningControl\FTE Control\" & strBrandSelection
strNetworkFolder = strNetworkFolder & "\" & strYear
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
strNetworkFolder = strNetworkFolder & "\" & strPeriod
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
strNetworkFolder = strNetworkFolder & "\Issued"
If objFSO.folderexists(strNetworkFolder) Then
Else
objFSO.createfolder (strNetworkFolder)
End If
End If
'create the LDA Return Data Summary folders where required
strDataFolder = strDataFolder & "LDA Returns\Draft Glide Paths"
If objFSO.folderexists(strDataFolder) Then
Else
objFSO.createfolder (strDataFolder)
End If
strDataFolder = strDataFolder & "\" & strYear
If objFSO.folderexists(strDataFolder) Then
Else
objFSO.createfolder (strDataFolder)
End If
End Sub
'get a copy of the LDA Return template from the network
Sub CopyLDAReturnTemplate()
Application.StatusBar = "Copying the LDA Return Template to the desktop"
objFSO.CopyFile strLDAReturnFile, strLDAReturnTemplateFolder & "\"
End Sub
'gets the HRIS data branch and group strucuture fro the month
Sub GetHRISData()
Dim wbHRISData As Workbook
Dim intColCount As Integer
Dim rngChannelColumn As Range
Dim rngGroupStructure As Range
Dim rngBranchStructureDataStart As Range
Application.StatusBar = "Getting the HRIS Data"
'set the ranges where the data needs copying to
Set rngGroupStructureStart = Range("GroupData_Start")
Set rngBranchStructureDataStart = Range("BranchStructureData_Start")
Set rngHRISDataStart = Range("HRISData_Start")
'open the HRIS data file
Set wbHRISData = Workbooks.Open(strHRISDataFile)
'establish where data is and copy
Sheets("LDA Returns").Select
'Set rngChannelColumn = Range("A2")
'Do Until rngChannelColumn = "Channel"
' Set rngChannelColumn = rngChannelColumn.Offset(0, 1)
'Loop
'intColCount = rngChannelColumn.Column
'Set rngChannelColumn = Nothing
Set rngHRISData = Range("AllData")
rngHRISData.Copy
rngHRISDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngHRISData = Nothing
'copy the group structure
Set rngGroupStructure = Range("GroupStructure_Structure")
rngGroupStructure.Copy
rngGroupStructureStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'copy the branch strucutre
Set rngBranchStructureData = Sheets("Branch Structure").Range("BranchStructure_StructureIncBrand")
rngBranchStructureData.Copy
rngBranchStructureDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'close the data file
Application.CutCopyMode = False
wbHRISData.Close savechanges:=False
Set wbHRISData = Nothing
wbLDAReturnProcess.Activate
Sheets("HRIS Data").Select
Set rngHRISData = Selection
Range(rngHRISData, rngHRISData.Offset(-1, 0)).Select
'turn off and back on the filters to clear any that had been set preoviously
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
Selection.AutoFilter
Else
Selection.AutoFilter
End If
Sheets("Branch Structure").Select
Set rngBranchStructureData = Selection
Range(rngBranchStructureData, rngBranchStructureData.Offset(-1, 0)).Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
Selection.AutoFilter
Else
Selection.AutoFilter
End If
Set rngGroupStructure = Nothing
Set rngBranchStructureDataStart = Nothing
Set rngGroupStructureStart = Nothing
End Sub
'Get the budget data
Sub GetBudgetData()
Dim wbBudget As Workbook
Dim rngBudgetDataStart As Range
Application.StatusBar = "Getting the Budget Data"
Set rngBrand = Range("Data_BrandStart")
Set rngBudgetDataStart = Range("BudgetData_Start")
strDataFolder = "\\Global.lloydstsb.com\file\ResourcePlanningControl\shared\ResourcePlanningControl\FTE Control\Common Files\Outputs\Budget\"
'open the budget file/s dependant on which cb has been selected
If strBrandSelection = "All" Then
Do Until rngBrand = ""
Set wbBudget = Workbooks.Open(strDataFolder & "\" & rngBrand & " Budget.xlsb")
Sheets("Branch").Select
ActiveSheet.AutoFilterMode = False
Set rngBudgetData = Range("Branch_Start")
Set rngBudgetData = Range(rngBudgetData, rngBudgetData.End(xlDown))
rngBudgetData.Copy
rngBudgetDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(rngBudgetDataStart.Offset(0, 1), rngBudgetDataStart.End(xlDown).Offset(0, 1)) = "Branch"
Set rngBudgetData = rngBudgetData.Offset(0, 1).Resize(, 29)
rngBudgetData.Copy
rngBudgetDataStart.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngBudgetDataStart = rngBudgetDataStart.End(xlDown).Offset(1, 0)
Sheets("Mortgages").Select
ActiveSheet.AutoFilterMode = False
Set rngBudgetData = Range("Mortgages_Start")
Set rngBudgetData = Range(rngBudgetData, rngBudgetData.End(xlDown))
rngBudgetData.Copy
rngBudgetDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(rngBudgetDataStart.Offset(0, 1), rngBudgetDataStart.End(xlDown).Offset(0, 1)) = "Mortgages"
Set rngBudgetData = rngBudgetData.Offset(0, 1).Resize(, 29)
rngBudgetData.Copy
rngBudgetDataStart.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngBudgetDataStart = rngBudgetDataStart.End(xlDown).Offset(1, 0)
Sheets("Bancassurance").Select
ActiveSheet.AutoFilterMode = False
Set rngBudgetData = Range("Bancassurance_Start")
Set rngBudgetData = Range(rngBudgetData, rngBudgetData.End(xlDown))
rngBudgetData.Copy
rngBudgetDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(rngBudgetDataStart.Offset(0, 1), rngBudgetDataStart.End(xlDown).Offset(0, 1)) = "Bancassurance"
Set rngBudgetData = rngBudgetData.Offset(0, 1).Resize(, 29)
rngBudgetData.Copy
rngBudgetDataStart.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngBudgetDataStart = rngBudgetDataStart.End(xlDown).Offset(1, 0)
Application.CutCopyMode = False
Set rngBudgetData = Nothing
wbBudget.Close savechanges:=False
Set wbBudget = Nothing
Set rngBrand = rngBrand.Offset(1, 0)
Loop
Else
Set wbBudget = Workbooks.Open(strBudgetDataFile)
Set rngBudgetData = Range("Branch_Start")
Set rngBudgetData = Range(rngBudgetData, rngBudgetData.End(xlDown).Offset(0, 30))
rngBudgetData.Copy
rngBudgetDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set rngBudgetData = Nothing
wbBudget.Close savechanges:=False
Set wbBudget = Nothing
Set rngBudgetData = Selection
Range(Selection, Selection.Offset(-1, 0)).Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
Selection.AutoFilter
Else
Selection.AutoFilter
End If
End If
Set rngBudgetData = Range("BudgetData_Start")
Set rngBudgetData = Range(rngBudgetData, rngBudgetData.End(xlDown).Offset(0, 30))
rngBudgetData.Select
End Sub
'Get Prior LDA Return data to be carried forward to new LDA Returns
Sub GetPriorLDAReturnData()
Dim wbPriorLDAReturn As Workbook
Application.StatusBar = "Getting the Prior LDA Return Data"
Set rngPriorLDGMovementStart = Range("PriorLDGMovementData_Start")
Set rngPriorInflowStart = Range("PriorInflowData_Start")
'open the budget fuile
Set wbPriorLDAReturn = Workbooks.Open(strPriorLDAReturnDataFile)
Set rngPriorLDGMovementData = Range("LDGMovement_AllData")
rngPriorLDGMovementData.Copy
rngPriorLDGMovementStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngPriorInflowData = Range("Inflow_AllData")
rngPriorInflowData.Copy
rngPriorInflowStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngPriorLDGMovementData = Nothing
Set rngPriorInflowData = Nothing
Application.CutCopyMode = False
wbPriorLDAReturn.Close savechanges:=False
Set wbPriorLDAReturn = Nothing
wbLDAReturnProcess.Activate
Sheets("Prior LDG Movement Data").Select
Set rngPriorLDGMovementData = Selection
Range(rngPriorLDGMovementData, rngPriorLDGMovementData.Offset(-1, 0)).Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
Selection.AutoFilter
Else
Selection.AutoFilter
End If
Sheets("Prior Inflow Data").Select
Set rngPriorInflowData = Selection
Range(rngPriorInflowData, rngPriorInflowData.Offset(-1, 0)).Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
Selection.AutoFilter
Else
Selection.AutoFilter
End If
Set rngPriorLDGMovementStart = Nothing
Set rngPriorInflowStart = Nothing
End Sub
'Get the attrition data
Sub GetAttritionData()
Dim wbAttritionData As Workbook
Dim rngAtrritionRoleOffset As Range
Application.StatusBar = "Getting the Attrition Data"
Set rngAttritionDataStart = Range("AttritionData_Start")
Set rngAtrritionRoleOffsetStart = Range("AttritionRoleOffset_ColumnOffsetStart")
Set wbAttritionData = Workbooks.Open(strAttritionDataFile)
Set rngAttritionData = Range("AttritionRates_DataStart")
Set rngAttritionData = Range(rngAttritionData, rngAttritionData.Offset(500, 122))
rngAttritionData.Copy
rngAttritionDataStart.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set rngAtrritionRoleOffset = Range("RoleOffset_ColumnOffset")
rngAtrritionRoleOffset.Copy
rngAtrritionRoleOffsetStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set rngAttritionData = Nothing
wbAttritionData.Close savechanges:=False
Set wbAttritionData = Nothing
wbLDAReturnProcess.Activate
Sheets("Attrition Data").Select
rngAttritionDataStart.Select
End Sub
'Create the New LDA Returns
Sub CreateLDAReturns()
Dim rngErrors As Range 'range to log any errors on the LDA Return when compiled
Dim strAddress As String
Dim bool2007 As Boolean 'flag for whether .xlsb file can be used
Dim rng2007 As Range 'start of range that jholds list of .xlsb users
Dim boolHRISData As Boolean 'flag for if HRIS data exists for LDG
Dim boolPriorLDGMovementData As Boolean 'flag for if Prior LDG movement data exists for LDG
Dim boolPriorInflowData As Boolean 'flag for if prior Inflowdata exists for LDG
Dim boolBudgetData As Boolean 'flag for if budget data exists for group
Dim rngLDGMovementEnd As Range 'cell after the last row on ldg movement sheet
Dim rngBudgetDataStart As Range 'cell to copy budget data to on the template
Dim rngLDGMovementSummaryStart As Range 'start of ldg movement summary data
Dim rngLDGMovementSummaryEnd As Range 'cell after the last row on ldg movement summary sheet
Dim rngRoleAttritionStart As Range 'start of roles in the cb for getting attritoin data
Dim rngLDAReturnBranchStructureDataStart As Range 'cell to copy branch structure to
Dim rngStaffData As Range 'cell to copy all staff data to
Dim dtAttritionMonth As Date 'dt of the month that forecasted attrition starts
Dim rngAttrition As Range 'start of the attrition data to find the group data
Dim intAttritionColumnOffset As Integer 'column offset for the role attrition to be added
Dim rngRoleOffset As Range '
Dim intRoleOffset As Integer
Dim strBrand As String
Dim intBrand As Integer
Dim intChannel As Integer
Dim intRegion As Integer
Dim intLDG As Integer
Dim rngColumn As Range
Dim strFilePathName As String 'name of the file to be stored in the LDA REturn
Dim rngChannel As Range
Dim boolRegionFile As Boolean
Dim wsProcedure As Worksheet
Dim wsDefinitions As Worksheet
Dim wsSummary As Worksheet
Dim wsLDGMovementSummary As Worksheet
Dim wsLookups As Worksheet
Dim wsData As Worksheet
Dim wsStaffRef As Worksheet
Dim wsBudget As Worksheet
Dim wsAttritionTotals As Worksheet
Application.StatusBar = "Creating the LDA Return files"
Set rngLDG = Range("GroupData_Start")
Set rngErrors = Range("Error_Start")
Range(rngErrors, rngErrors.Offset(500, 2)).ClearContents
Set rngLDGMovement = Range("LDGMovement_Start")
Set rngChannel = Range("Data_ChannelStart")
Do Until rngChannel = ""
If rngChannel = "Branch" Then
boolRegionFile = False
Else
boolRegionFile = True
End If
Do Until rngLDG = ""
If strBrandSelection = "All" Then
strLDG = rngLDG.Offset(0, 2)
Else
Do Until rngLDG = strBrandSelection Or rngLDG = ""
Set rngLDG = rngLDG.Offset(1, 0)
Loop
strLDG = rngLDG.Offset(0, 2)
End If
strBrand = rngLDG
strRegion = rngLDG.Offset(0, 1)
Set rng2007 = Range("List2007_Start")
Do Until rng2007.Offset(0, 1) = strRegion And rng2007.Offset(0, 2) = strLDG
Set rng2007 = rng2007.Offset(1, 0)
Loop
If rng2007.Offset(0, 3) = "Yes" Then
bool2007 = True
Else
bool2007 = False
End If
On Error Resume Next
Sheets("HRIS Data").Select
Set rngColumn = Range("A2")
Do Until rngColumn = ""
Select Case rngColumn
Case "Brand"
intBrand = rngColumn.Column
Case "Channel"
intChannel = rngColumn.Column
Case "Region"
intRegion = rngColumn.Column
Case "LDG"
intLDG = rngColumn.Column
Case Else
End Select
Set rngColumn = rngColumn.Offset(0, 1)
Loop
'establish if any HRIS data fro the group
strAddress = rngHRISData.Address
With ActiveSheet.Range(strAddress)
.AutoFilter field:=intBrand, Criteria1:=rngLDG
.AutoFilter field:=intChannel, Criteria1:=rngChannel
.AutoFilter field:=intRegion, Criteria1:=strRegion
If boolRegionFile = True Then
Else
.AutoFilter field:=intLDG, Criteria1:=strLDG
End If
End With
If rngHRISData.SpecialCells(xlCellTypeVisible).Count = 0 Then
boolHRISData = False
Else
boolHRISData = True
End If
Sheets("Branch Structure").Select
Set rngColumn = Range("A2")
Do Until rngColumn = ""
Select Case rngColumn
Case "Brand"
intBrand = rngColumn.Column
Case "Channel"
intChannel = rngColumn.Column
Case "Region"
intRegion = rngColumn.Column
Case "LDG"
intLDG = rngColumn.Column
Case Else
End Select
Set rngColumn = rngColumn.Offset(0, 1)
Loop
strAddress = rngBranchStructureData.Address
With ActiveSheet.Range(strAddress)
.AutoFilter field:=intBrand, Criteria1:=rngLDG
.AutoFilter field:=intChannel, Criteria1:=rngChannel
.AutoFilter field:=intRegion, Criteria1:=strRegion
If boolRegionFile = True Then
Else
.AutoFilter field:=intLDG, Criteria1:=strLDG
End If
End With
Sheets("Prior LDG Movement Data").Select
Set rngColumn = Range("A2")
Do Until rngColumn = ""
Select Case rngColumn
Case "Brand"
intBrand = rngColumn.Column
Case "Channel"
intChannel = rngColumn.Column
Case "Region"
intRegion = rngColumn.Column
Case "LDG"
intLDG = rngColumn.Column
Case Else
End Select
Set rngColumn = rngColumn.Offset(0, 1)
Loop
strAddress = rngPriorLDGMovementData.Address
With ActiveSheet.Range(strAddress)
.AutoFilter field:=intBrand, Criteria1:=rngLDG
.AutoFilter field:=intChannel, Criteria1:=rngChannel
.AutoFilter field:=intRegion, Criteria1:=strRegion
If boolRegionFile = True Then
Else
.AutoFilter field:=intLDG, Criteria1:=strLDG
End If
End With
If rngPriorLDGMovementData.SpecialCells(xlCellTypeVisible).Count = 0 Then
boolPriorLDGMovementData = False
Else
boolPriorLDGMovementData = True
End If
Sheets("Prior Inflow Data").Select
Set rngColumn = Range("A2")
Do Until rngColumn = ""
Select Case rngColumn
Case "Brand"
intBrand = rngColumn.Column
Case "Channel"
intChannel = rngColumn.Column
Case "Region"
intRegion = rngColumn.Column
Case "LDG"
intLDG = rngColumn.Column
Case Else
End Select
Set rngColumn = rngColumn.Offset(0, 1)
Loop
strAddress = rngPriorInflowData.Address
With ActiveSheet.Range(strAddress)
.AutoFilter field:=intBrand, Criteria1:=rngLDG
.AutoFilter field:=intChannel, Criteria1:=rngChannel
.AutoFilter field:=intRegion, Criteria1:=strRegion
If boolRegionFile = True Then
Else
.AutoFilter field:=intLDG, Criteria1:=strLDG
End If
End With
If rngPriorInflowData.SpecialCells(xlCellTypeVisible).Count = 0 Then
boolPriorInflowData = False
Else
boolPriorInflowData = True
End If
Sheets("Budget Data").Select
Set rngColumn = Range("A2")
Do Until rngColumn = ""
Select Case rngColumn
Case "Brand"
intBrand = rngColumn.Column
Case "Channel"
intChannel = rngColumn.Column
Case "Region"
intRegion = rngColumn.Column
Case "LDG"
intLDG = rngColumn.Column
Case Else
End Select
Set rngColumn = rngColumn.Offset(0, 1)
Loop
strAddress = rngBudgetData.Address
With ActiveSheet.Range(strAddress)
.AutoFilter field:=intBrand, Criteria1:=rngLDG
.AutoFilter field:=intChannel, Criteria1:=rngChannel
.AutoFilter field:=intRegion, Criteria1:=strRegion
If boolRegionFile = True Then
Else
.AutoFilter field:=intLDG, Criteria1:=strLDG
End If
End With
rngBudgetData.Select
If rngBudgetData.SpecialCells(xlCellTypeVisible).Count = 0 Then
boolBudgetData = False
Else
boolBudgetData = True
End If
On Error GoTo 0
'open the template file
Set wbLDAReturn = Workbooks.Open(Replace(strDesktopFolder, "\Issued", "") & "\LDA Return Template.xls")
Set wsProcedure = wbLDAReturn.Sheets("Procedure")
Set wsDefinitions = wbLDAReturn.Sheets("Definitions")
Set wsSummary = wbLDAReturn.Sheets("Summary")
Set wsLDGMovement = wbLDAReturn.Sheets("LDG Movement")
Set wsLDGMovementSummary = wbLDAReturn.Sheets("LDG Movement Summary")
Set wsInflow = wbLDAReturn.Sheets("Inflow")
Set wsLookups = wbLDAReturn.Sheets("Lookups")
Set wsData = wbLDAReturn.Sheets("Data")
Set wsPriorLDGMovement = wbLDAReturn.Sheets("Prior LDG Movement")
Set wsPriorInflow = wbLDAReturn.Sheets("Prior Inflow")
Set wsStaffRef = wbLDAReturn.Sheets("Staff Ref")
Set wsBudget = wbLDAReturn.Sheets("Budget")
Set wsAttritionTotals = wbLDAReturn.Sheets("Attrition Totals")
'set the ranges where data needs copying to
Set rngBudgetDataStart = wsBudget.Range("Budget_Start")
Set rngLDGMovementStart = wsLDGMovement.Range("LDGMovement_Start")
Set rngLDGMovementEnd = wsLDGMovement.Range("LDGMovement_End").Offset(-1, 0)
Set rngLDGMovementSummaryStart = wsLDGMovementSummary.Range("LDGMovementSummary_Start")
Set rngLDGMovementSummaryEnd = wsLDGMovementSummary.Range("LDGMovementSummary_End").Offset(-1, 0)
Set rngRoleAttritionStart = wsLookups.Range("Lookups_RoleStart")
Set rngLDAReturnBranchStructureDataStart = wsLookups.Range("Lookups_BranchStructureStart")
Set rngStaffData = wsStaffRef.Range("StaffRef_Start")
Set rngPriorLDGMovementStart = wsPriorLDGMovement.Range("PriorLDGMovement_Start")
Set rngPriorInflowStart = wsPriorInflow.Range("PriorInflow_Start")
'add the 1st forecasted attrion month
dtAttritionMonth = ("1 " & Month(dtDate) + 2 & " " & strYear)
'add the required data to the return
wsData.Range("Data_Brand") = strBrand
wsData.Range("Data_Channel") = rngChannel
wsData.Range("Data_Region") = strRegion
wsData.Range("Data_LDG") = strLDG
wsData.Range("Data_HRISDate") = dtDate
wbLDAReturnProcess.Activate
Sheets("HRIS Data").Select
'copy the hris data to the template
rngHRISData.Select
Selection.Resize(rngHRISData.Rows.Count, rngHRISData.Columns.Count - 7).Select
Selection.Copy
rngLDGMovementStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
rngHRISData.Select
Selection.Offset(0, 3).Select
Selection.Resize(rngHRISData.Rows.Count, rngHRISData.Columns.Count - 7).Select
Selection.Copy
rngLDGMovementStart.Offset(0, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Branch Structure").Select
rngBranchStructureData.Select
Selection.Offset(0, 4).Select
Selection.Resize(, 1).Select
Selection.Copy
rngLDAReturnBranchStructureDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Branch Structure").Select
rngBranchStructureData.Select
Selection.Offset(0, 3).Select
Selection.Resize(, 1).Select
Selection.Copy
rngLDAReturnBranchStructureDataStart.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbLDAReturn.Activate
wsLDGMovement.Select
rngLDGMovementStart.Select
Range(rngLDGMovementStart.End(xlDown).Offset(1, 0), rngLDGMovementEnd).EntireRow.Delete
intRowCount = Range(Selection, Selection.End(xlDown)).Rows.Count
wsLDGMovementSummary.Select
'if the HRIS data is less than 100 rows then reduce the LDG summry sheet to the same number of rows
If intRowCount < 100 Then
Range("LDGMovementSummary_Start").Offset(intRowCount, 0).Select
Range(Selection, rngLDGMovementSummaryEnd).EntireRow.Delete
Else
End If
If boolPriorLDGMovementData = True Then
wbLDAReturnProcess.Activate
Sheets("Prior LDG Movement Data").Select
rngPriorLDGMovementData.Select
Selection.Resize(rngPriorLDGMovementData.Rows.Count, rngPriorLDGMovementData.Columns.Count - 4).Select
Selection.Copy
rngPriorLDGMovementStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
If boolPriorInflowData = True Then
Sheets("Prior Inflow Data").Select
rngPriorInflowData.Select
Selection.Resize(rngPriorInflowData.Rows.Count, rngPriorInflowData.Columns.Count - 4).Select
Selection.Copy
rngPriorInflowStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
If boolBudgetData = True Then
Sheets("Budget Data").Select
rngBudgetData.Select
Selection.Resize(rngBudgetData.Rows.Count, rngBudgetData.Columns.Count - 26).Select
Selection.Offset(0, 2).Select
Selection.Copy
rngBudgetDataStart.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
rngBudgetData.Select
Selection.Offset(0, 5 + Month(dtDate) + 1).Select
Selection.Resize(rngBudgetData.Rows.Count, rngBudgetData.Columns.Count - 6 - Month(dtDate) - (12 - Month(dtDate - 1))).Select
Selection.Copy
rngBudgetDataStart.Offset(0, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
Calculate
Sheets("Attrition Data").Select
'get the attrition rates for roles in the CB
Set rngAttrition = Range("AttritionData_Start")
Set rngRoleOffset = Range("AttritionRoleOffset_ColumnOffset")
Do Until rngAttrition = rngLDG And rngAttrition.Offset(0, 1) = strRegion And rngAttrition.Offset(0, 2) = strLDG
Set rngAttrition = rngAttrition.Offset(1, 0)
Loop
Do Until rngRoleAttritionStart = ""
If Not IsError(Application.VLookup(rngRoleAttritionStart, rngRoleOffset, 2, False)) Then
intRoleOffset = Application.WorksheetFunction.VLookup(rngRoleAttritionStart, rngRoleOffset, 2, False)
Range(rngAttrition.Offset(0, intRoleOffset + Month(dtDate) - 1), rngAttrition.Offset(0, intRoleOffset + 9 + Month(dtDate))).Copy
rngRoleAttritionStart.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
Set rngRoleAttritionStart = rngRoleAttritionStart.Offset(1, 0)
Loop
'if any prior LDG Movement data then check if needs carying forward
If boolPriorLDGMovementData = True Then
PriorLDGMovement
Else
Set rngLDGMovementData = Range(rngLDGMovementStart, rngLDGMovementStart.Offset(intRowCount - 1, 5))
End If
If boolPriorInflowData = True Then
PriorInflow
Else
End If
Set rngLDGMovementData = Nothing
Set rngLDGMovementEnd = Nothing
'copy full staff list for checking any inflows
wbLDAReturnProcess.Activate
Sheets("HRIS Data").Select
ActiveSheet.ShowAllData
rngHRISData.Select
Selection.Resize(rngHRISData.Rows.Count, rngHRISData.Columns.Count - rngHRISData.Columns.Count + 1).Select
Selection.Copy
rngStaffData.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(Selection.Offset(0, 6), Selection.Offset(0, 8)).Select
Selection.Copy
rngStaffData.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
strFilePathName = strDesktopFolder & "\" & rngLDG & "\" & strRegion & "\" & strLDG & " " & strDate
'establuis file format required
If bool2007 = True Then
strFilePathName = strFilePathName & ".xlsb"
Else
strFilePathName = strFilePathName & ".xls"
End If
wbLDAReturn.Activate
Sheets("Data").Range("Data_FilePathName") = Replace(strFilePathName, strDesktopFolder & "\Issued\", "")
'hide the branch code column for LCB files
If rngLDG = "Halifax" And rngChannel = "Branch" Then
Else
wsLDGMovement.Range("LDGMovement_Accredited").EntireColumn.Hidden = True
wsLDGMovement.Range("LDGMovement_MRAStatus").EntireColumn.Hidden = True
wsLDGMovement.Range("LDGMovement_BranchCodeCol").EntireColumn.Hidden = True
wsInflow.Range("Inflow_BranchCode").EntireColumn.Hidden = True
wsLDGMovementSummary.Range("LDGMovementSummary_Accredited").EntireColumn.Hidden = True
wsLDGMovementSummary.Range("LDGMovementSummary_MRAStatus").EntireColumn.Hidden = True
wsLDGMovementSummary.Range("LDGMovementSummary_BranchCode").EntireColumn.Hidden = True
End If
Application.DisplayAlerts = False
'hide def rows not applicable to HCB of a HCB file
wsDefinitions.Select
' If rngLDG = "Halifax" Then
' Rows("13:14").Hidden = True
' Rows("39:40").Hidden = True
' Rows("51:52").Hidden = True
' Else
' End If
Range("A1").Select
'delete and protect sheets where applicable
wsProcedure.Protect Password:="information"
wsDefinitions.Protect Password:="information"
wsSummary.Protect Password:="information"
wsLDGMovement.Protect Password:="information", AllowFiltering:=True
wsInflow.Protect Password:="information"
wsLDGMovementSummary.Protect Password:="information", AllowFiltering:=True
wsPriorLDGMovement.Delete
wsPriorInflow.Delete
wsStaffRef.Visible = xlVeryHidden
wsLookups.Visible = xlVeryHidden
wsData.Visible = xlVeryHidden
wsBudget.Visible = xlVeryHidden
wsAttritionTotals.Visible = xlVeryHidden
Set wsDefinitions = Nothing
Set wsPriorLDGMovement = Nothing
Set wsPriorInflow = Nothing
Set wsStaffRef = Nothing
Set wsLookups = Nothing
Set wsData = Nothing
Set wsBudget = Nothing
Set wsAttritionTotals = Nothing
Application.DisplayAlerts = True
'set up file for fisrt use
wsSummary.Select
Range("Summary_Branch").Select
Set wsSummary = Nothing
wsLDGMovement.Select
Range("I11").Select
Set wsLDGMovement = Nothing
Sheets("Inflow").Select
Range("Inflow_Start").Select
Set wsInflow = Nothing
Sheets("LDG Movement Summary").Select
rngLDGMovementSummaryStart.Select
Set rngLDGMovementSummaryStart = Nothing
Set rngLDGMovementSummaryEnd = Nothing
Set wsLDGMovementSummary = Nothing
Sheets("Procedure").Select
Set wsProcedure = Nothing
Set wsDefinitions = Nothing
Set wsPriorLDGMovement = Nothing
Set wsPriorInflow = Nothing
Set wsStaffRef = Nothing
Set wsData = Nothing
'clear range objects
Set rngBudgetDataStart = Nothing
Set wsBudget = Nothing
Set wsLookups = Nothing
Set rngRoleAttritionStart = Nothing
Set rngLDAReturnBranchStructureDataStart = Nothing
Set rngStaffData = Nothing
Set rngAttrition = Nothing
Set wsAttritionTotals = Nothing
Set rngRoleOffset = Nothing
' Set intRoleOffset = Nothing
'log if any errors on the new file
If Range("LDGMovement_Errors") <> "" Or Range("Inflow_Errors") <> "" Then
rngErrors = strRegion
rngErrors.Offset(0, 1) = strLDG
Set rngErrors = rngErrors.Offset(1, 0)
Else
End If
'save the file
If bool2007 = True Then
wbLDAReturn.SaveAs Filename:=strFilePathName, FileFormat:=50
Else
wbLDAReturn.SaveAs Filename:=strFilePathName, FileFormat:=56
End If
If boolSummaryData = True Then
GetLDAReturnData
Else
End If
wbLDAReturn.Close savechanges:=False
Set wbLDAReturn = Nothing
Set rngLDG = rngLDG.Offset(1, 0)
Loop
Set rngChannel = rngChannel.Offset(1, 0)
Loop
'clear the filters
Sheets("Prior LDG Movement Data").Select
ActiveSheet.ShowAllData
Sheets("Prior Inflow Data").Select
ActiveSheet.ShowAllData
Sheets("Budget Data").Select
ActiveSheet.ShowAllData
Sheets("Branch Structure").Select
ActiveSheet.ShowAllData
Set rngLDG = Nothing
End Sub
Sub PriorLDGMovement()
Dim lngStaffID As Long 'current HRIS staff id vaalue
Dim lngPriorStaffID As Long 'prior LDG movement data stff id value
Dim rngStaffID As Range 'range of current staff id
Dim rngPriorStaffID As Range 'range of prior LDG Movement staff id
Dim intPriorMovementDate As Integer 'date of prior ldg movement ot caryr forward column number
Dim intPriorNewFTE As Integer 'FTE of prior ldg movement ot caryr forward column number
Dim intPriorNewRole As Integer 'New Role of prior ldg movement ot caryr forward column number
Dim intPriorRoleDate As Integer 'new role date of prior ldg movement ot caryr forward column number
Dim intCurrentFTE As Integer 'Current HRIS FTE column number
Dim intChange As Integer 'column number of change column
Dim intNewFTE As Integer 'column number of new fte
Dim intNewRole As Integer 'column number of new role
Dim intRoleDate As Integer ' column number of new role date
Dim strPriorType As String
Dim strPriorTypeCF As String
Dim boolAdded As Boolean
'gets the column numbers and sets ranges to lstart looking
intLDGMovementBranchName = wsLDGMovement.Range("LDGMovement_BranchName").Column - 1
intRole = wsLDGMovement.Range("LDGMovement_Role").Column - 1
intCurrentFTE = wsLDGMovement.Range("LDGMovement_CurrentFTE").Column - 1
intChange = wsLDGMovement.Range("LDGMovement_Change").Column - 1
intType = wsLDGMovement.Range("LDGMovement_Type").Column - 1
intDate = wsLDGMovement.Range("LDGMovement_MovementDate").Column - 1
intNewFTE = wsLDGMovement.Range("LDGMovement_NewFTE").Column - 1
intNewRole = wsLDGMovement.Range("LDGMovement_NewRole").Column - 1
intRoleDate = wsLDGMovement.Range("LDGMovement_RoleDate").Column - 1
intNotes = wsLDGMovement.Range("LDGMovement_Notes").Column - 1
Set rngPriorStaffID = rngPriorLDGMovementStart
Set rngLDGMovementData = Range(rngLDGMovementStart, rngLDGMovementStart.Offset(intRowCount - 1, intChange))
intPriorRole = wsPriorLDGMovement.Range("PriorLDGMovement_Role").Column - 1
intPriorBranchName = wsPriorLDGMovement.Range("PriorLDGMovement_BranchName").Column - 1
intPriorType = wsPriorLDGMovement.Range("PriorLDGMovement_Type").Column - 1
intPriorMovementDate = wsPriorLDGMovement.Range("PriorLDGMovement_MovementDate").Column - 1
intPriorNewFTE = wsPriorLDGMovement.Range("PriorLDGMovement_NewFTE").Column - 1
intPriorNewRole = wsPriorLDGMovement.Range("PriorLDGMovement_NewRole").Column - 1
intPriorRoleDate = wsPriorLDGMovement.Range("PriorLDGMovement_RoleDate").Column - 1
intPriorNotes = wsPriorLDGMovement.Range("PriorLDGMovement_Notes").Column - 1
Do Until rngPriorStaffID = ""
boolAdded = False
lngPriorStaffID = rngPriorStaffID
strPriorType = rngPriorStaffID.Offset(0, intPriorType)
strPriorTypeCF = strPriorType
'assign a movement type of prior ldg movement
Select Case Left(strPriorType, 8)
Case "Leaver E"
strPriorType = "Leaver"
Case "Transfer"
If Right(strPriorType, 3) = "LDG" Then
strPriorType = "Inside LDG"
Else
strPriorType = "Leaver"
End If
Case Else
End Select
'checks if prior ldg movement needs carrying forward
If Not IsError(Application.VLookup(lngPriorStaffID, rngLDGMovementData, 1, 0)) Then
Set rngStaffID = rngLDGMovementStart
Do Until rngStaffID = lngPriorStaffID
Set rngStaffID = rngStaffID.Offset(1, 0)
Loop
Select Case strPriorType
Case "Leaver"
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = strPriorTypeCF
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = 0
boolAdded = True
Case "Inside LDG"
If rngPriorStaffID.Offset(0, intPriorBranchName) = rngStaffID.Offset(0, intLDGMovementBranchName) Then
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = "Transfer Out Inside LDG"
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = 0
boolAdded = True
Else
End If
Case "Maternity/Paternity/Other Leave"
If rngStaffID.Offset(0, intCurrentFTE) = 0 Then
Else
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = "Maternity/Paternity/Other Leave"
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = 0
boolAdded = True
End If
Case "Maternity/Paternity/Other Return"
If rngStaffID.Offset(0, intCurrentFTE) = 0 Then
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = "Maternity/Paternity/Other Return"
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = rngPriorStaffID.Offset(0, intPriorNewFTE)
boolAdded = True
Else
End If
Case "Paid Hours Decrease"
If rngStaffID.Offset(0, intCurrentFTE) <= rngPriorStaffID.Offset(0, intPriorNewFTE) Then
Else
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = "Paid Hours Decrease"
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = rngPriorStaffID.Offset(0, intPriorNewFTE)
boolAdded = True
End If
Case "Paid Hours Increase"
If rngStaffID.Offset(0, intCurrentFTE) >= rngPriorStaffID.Offset(0, intPriorNewFTE) Then
Else
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intType) = "Paid Hours Increase"
If rngPriorStaffID.Offset(0, intPriorMovementDate) < dtDate Then
rngStaffID.Offset(0, intDate) = dtDate
Else
rngStaffID.Offset(0, intDate) = rngPriorStaffID.Offset(0, intPriorMovementDate)
End If
rngStaffID.Offset(0, intNewFTE) = rngPriorStaffID.Offset(0, intPriorNewFTE)
boolAdded = True
End If
Case 0
Case Else
End Select
'if a new role is in prior ldg movment, check if this is on new HRIS data and if not add to new file
If rngPriorStaffID.Offset(0, intPriorNewRole) = 0 Or rngPriorStaffID.Offset(0, intPriorNewRole) = "" Then
Else
If rngStaffID.Offset(0, intRole) = rngPriorStaffID.Offset(0, intPriorNewRole) Then
Else
rngStaffID.Offset(0, intChange) = "Yes"
rngStaffID.Offset(0, intNewRole) = rngPriorStaffID.Offset(0, intPriorNewRole)
If rngStaffID.Offset(0, intPriorRoleDate) < dtDate Then
rngStaffID.Offset(0, intRoleDate) = dtDate
Else
rngStaffID.Offset(0, intRoleDate) = rngPriorStaffID.Offset(0, intPriorRoleDate)
End If
boolAdded = True
End If
End If
'adds any notes from the prior ldg movement
If Not IsError(rngPriorStaffID.Offset(0, intPriorNotes)) Then
If rngPriorStaffID.Offset(0, intPriorNotes) = "" Then
Else
If boolAdded = True Then
rngStaffID.Offset(0, intNotes) = rngPriorStaffID.Offset(0, intPriorNotes)
Else
End If
End If
Else
End If
Else
End If
Set rngPriorStaffID = rngPriorStaffID.Offset(1, 0)
Loop
Set rngPriorStaffID = Nothing
Set rngStaffID = Nothing
End Sub
Sub PriorInflow()
Dim rngPriorInflow As Range
Dim rngInflow As Range
Dim intVRTRef As Integer
Dim intPriorName As Integer
Dim intPriorInflowDate As Integer
Dim intPriorFTE As Integer
Dim intPriorVRTRef As Integer
Dim intName As Integer
Dim intBranchName As Integer
Dim intFTE As Integer
Dim strTest As String
Dim boolAdded As Boolean
Set rngPriorInflow = rngPriorInflowStart
Set rngInflow = wbLDAReturn.Sheets("Inflow").Range("Inflow_Start")
intPriorVRTRef = wsPriorInflow.Range("PriorInflow_VRTRef").Column - 1
intPriorName = wsPriorInflow.Range("PriorInflow_Name").Column - 1
intPriorRole = wsPriorInflow.Range("PriorInflow_Role").Column - 1
intPriorInflowDate = wsPriorInflow.Range("PriorInflow_Date").Column - 1
intPriorType = wsPriorInflow.Range("PriorInflow_Type").Column - 1
intPriorBranchName = wsPriorInflow.Range("PriorInflow_BranchName").Column - 1
intPriorFTE = wsPriorInflow.Range("PriorInflow_FTE").Column - 1
intPriorNotes = wsPriorInflow.Range("PriorInflow_Notes").Column - 1
intVRTRef = wsInflow.Range("Inflow_VRTRef").Column - 1
intName = wsInflow.Range("Inflow_Name").Column - 1
intRole = wsInflow.Range("Inflow_Role").Column - 1
intDate = wsInflow.Range("Inflow_Date").Column - 1
intType = wsInflow.Range("Inflow_Type").Column - 1
intBranchName = wsInflow.Range("Inflow_BranchName").Column - 1
intFTE = wsInflow.Range("Inflow_FTE").Column - 1
intNotes = wsInflow.Range("Inflow_Notes").Column - 1
boolAdded = False
Do Until rngPriorInflow.Offset(0, intName) = ""
Select Case rngPriorInflow.Offset(0, intType)
Case "Transfer In Inside LDG"
'Perfomr VBA Vlookup to see if this inflow type has been actioned on the current HROIS data
If Not IsError(Application.VLookup(rngPriorInflow, rngLDGMovementData, 1, 0)) Then
If Application.VLookup(rngPriorInflow, rngLDGMovementData, intLDGMovementBranchName + 1, 0) = rngPriorInflow.Offset(0, intPriorBranchName) Then
Else
'If not then copy this data onto the current LDA Return template
rngInflow = rngPriorInflow
rngInflow.Offset(0, intName) = rngPriorInflow.Offset(0, intPriorName)
rngInflow.Offset(0, intRole) = rngPriorInflow.Offset(0, intPriorRole)
'if date on prior period inflow is before the minimum date fo rthis period then add in with the mon date
If rngPriorInflow.Offset(0, intPriorInflowDate) < dtDate Then
rngInflow.Offset(0, intDate) = dtDate
Else
rngInflow.Offset(0, intDate) = rngPriorInflow.Offset(0, intPriorInflowDate)
End If
rngInflow.Offset(0, intType) = rngPriorInflow.Offset(0, intPriorType)
rngInflow.Offset(0, intBranchName) = rngPriorInflow.Offset(0, intPriorBranchName)
rngInflow.Offset(0, intFTE) = rngPriorInflow.Offset(0, intPriorFTE)
Set rngInflow = rngInflow.Offset(1, 0)
boolAdded = True
End If
Else
End If
Case "Vacancy"
If rngPriorInflow = "" Then
Else
rngInflow = rngPriorInflow
End If
rngInflow.Offset(0, intVRTRef) = rngPriorInflow.Offset(0, intPriorVRTRef)
rngInflow.Offset(0, intName) = rngPriorInflow.Offset(0, intPriorName)
rngInflow.Offset(0, intRole) = rngPriorInflow.Offset(0, intPriorRole)
If rngPriorInflow.Offset(0, intPriorInflowDate) < dtDate Then
rngInflow.Offset(0, intDate) = dtDate
Else
rngInflow.Offset(0, intDate) = rngPriorInflow.Offset(0, intPriorInflowDate)
End If
rngInflow.Offset(0, intType) = rngPriorInflow.Offset(0, intPriorType)
rngInflow.Offset(0, intBranchName) = rngPriorInflow.Offset(0, intPriorBranchName)
rngInflow.Offset(0, intFTE) = rngPriorInflow.Offset(0, intPriorFTE)
Set rngInflow = rngInflow.Offset(1, 0)
boolAdded = True
Case "New Starter"
If rngPriorInflow.Offset(0, intDate) < dtDate Then
Else
If rngPriorInflow = "" Then
Else
rngInflow = rngPriorInflow
End If
rngInflow.Offset(0, intVRTRef) = rngPriorInflow.Offset(0, intPriorVRTRef)
rngInflow.Offset(0, intName) = rngPriorInflow.Offset(0, intPriorName)
rngInflow.Offset(0, intRole) = rngPriorInflow.Offset(0, intPriorRole)
If rngPriorInflow.Offset(0, intPriorInflowDate) < dtDate Then
rngInflow.Offset(0, intDate) = dtDate
Else
rngInflow.Offset(0, intDate) = rngPriorInflow.Offset(0, intPriorInflowDate)
End If
rngInflow.Offset(0, intType) = rngPriorInflow.Offset(0, intPriorType)
rngInflow.Offset(0, intBranchName) = rngPriorInflow.Offset(0, intPriorBranchName)
rngInflow.Offset(0, intFTE) = rngPriorInflow.Offset(0, intPriorFTE)
Set rngInflow = rngInflow.Offset(1, 0)
boolAdded = True
End If
Case "Internal Vacancy"
If rngPriorInflow = "" Then
Else
rngInflow = rngPriorInflow
End If
rngInflow.Offset(0, intVRTRef) = rngPriorInflow.Offset(0, intPriorVRTRef)
rngInflow.Offset(0, intName) = rngPriorInflow.Offset(0, intPriorName)
rngInflow.Offset(0, intRole) = rngPriorInflow.Offset(0, intPriorRole)
If rngPriorInflow.Offset(0, intPriorInflowDate) < dtDate Then
rngInflow.Offset(0, intDate) = dtDate
Else
rngInflow.Offset(0, intDate) = rngPriorInflow.Offset(0, intPriorInflowDate)
End If
rngInflow.Offset(0, intType) = rngPriorInflow.Offset(0, intPriorType)
rngInflow.Offset(0, intBranchName) = rngPriorInflow.Offset(0, intPriorBranchName)
rngInflow.Offset(0, intFTE) = rngPriorInflow.Offset(0, intPriorFTE)
Set rngInflow = rngInflow.Offset(1, 0)
boolAdded = True
Case Else
'all other inflows are checked to see if on the current HRIS data and added to the current LDA Return template if not
If Not IsError(Application.VLookup(rngPriorInflow, rngLDGMovementData, 1, 0)) Then
Else
rngInflow = rngPriorInflow
rngInflow.Offset(0, intName) = rngPriorInflow.Offset(0, intPriorName)
rngInflow.Offset(0, intRole) = rngPriorInflow.Offset(0, intPriorRole)
If rngPriorInflow.Offset(0, intDate) < dtDate Then
rngInflow.Offset(0, intDate) = dtDate
Else
rngInflow.Offset(0, intDate) = rngPriorInflow.Offset(0, intPriorInflowDate)
End If
rngInflow.Offset(0, intType) = rngPriorInflow.Offset(0, intPriorType)
rngInflow.Offset(0, intBranchName) = rngPriorInflow.Offset(0, intPriorBranchName)
rngInflow.Offset(0, intFTE) = rngPriorInflow.Offset(0, intPriorFTE)
Set rngInflow = rngInflow.Offset(1, 0)
boolAdded = True
End If
End Select
If rngInflow.Offset(0, intPriorNotes) = "" Then
Else
If boolAdded = True Then
rngInflow.Offset(0, intNotes) = rngPriorInflow.Offset(0, intPriorNotes)
Else
End If
End If
Set rngPriorInflow = rngPriorInflow.Offset(1, 0)
Loop
Set rngPriorInflow = Nothing
Set rngPriorInflow = Nothing
Set rngInflow = Nothing
End Sub
'create a file to be used in teh draft GP files compiled from the LDA REturn data of the new LDA Returns created
Sub GetLDAReturnData()
Dim rngLDGMovementGPData As Range
Dim rngInflowGPData As Range
Dim rngInflow As Range
Dim intCount As Integer
intCount = wsLDGMovement.Range("LDGMovement_ChangeCount")
If intCount = 0 Then
Else
Set rngLDGMovementGPData = wsLDGMovementSummary.Range("LDGMovementSummary_Start")
Set rngLDGMovementGPData = Range(rngLDGMovementGPData, rngLDGMovementGPData.Offset(intCount - 1, 12))
rngLDGMovementGPData.Copy
rngLDGMovement.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(rngLDGMovement.Offset(0, 14), rngLDGMovement.Offset(intCount - 1, 14)) = rngLDG
Range(rngLDGMovement.Offset(0, 15), rngLDGMovement.Offset(intCount - 1, 15)) = strRegion
Range(rngLDGMovement.Offset(0, 16), rngLDGMovement.Offset(intCount - 1, 16)) = strLDG
Set rngLDGMovement = rngLDGMovement.Offset(intCount, 0)
End If
Set rngInflow = wbLDAReturnProcess.Sheets("Inflow").Range("Inflow_Start")
Do Until rngInflow.Offset(0, 1) = ""
Set rngInflow = rngInflow.Offset(1, 0)
Loop
Set rngInflowGPData = wbLDAReturn.Sheets("Inflow").Range("Inflow_Start")
Do Until rngInflowGPData.Row = wbLDAReturn.Sheets("Inflow").Range("Inflow_End").Row
If rngInflowGPData.Offset(0, 1) = "" Or rngInflowGPData.Offset(0, 9) <> "" Then
Else
Range(rngInflowGPData, rngInflowGPData.Offset(0, 8)).Copy
rngInflow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
rngInflow.Offset(0, 10) = rngLDG
rngInflow.Offset(0, 11) = strRegion
rngInflow.Offset(0, 12) = strLDG
Set rngInflow = rngInflow.Offset(1, 0)
End If
Set rngInflowGPData = rngInflowGPData.Offset(1, 0)
Loop
Application.CutCopyMode = False
End Sub
'asves the glide path data file
Sub SaveGlidePathDataFile()
Dim wbLDAReturnData As Workbook
Sheets(Array("LDG Movement", "Inflow")).Copy
Set wbLDAReturnData = ActiveWorkbook
wbLDAReturnData.SaveAs Filename:=strDataFolder & "\Draft Glide Path Data " & strDate & ".xlsb", FileFormat:=50
wbLDAReturnData.Close savechanges:=False
Set wbLDAReturnData = Nothing
End Sub
'copy the new lda returns to the public folder
Sub CopyToPublicFolder()
Dim strPublicFolder As String
Dim mbPublic
mbPublic = MsgBox("Do you want to copy the files to the Public folder?" & vbCr & vbCr & _
"This will take some time dependant on your network connection - 30 minutes to 4 hours." & vbCr & vbCr & _
"Click 'Yes' to copy or 'No' to do this manually", vbYesNo, "Archive")
If mbPublic = vbYes Then
strPublicFolder = "\\Global.lloydstsb.com\file\ResourcePlanningControl\shared\Projects\Public Folder\LDA Returns"
Application.StatusBar = "Copying the LDA Returns file to the public folder"
objFSO.CopyFolder Source:=strDesktopFolder & "\Issued", Destination:=strPublicFolder
Else
End If
Application.StatusBar = False
End Sub
'Copy the LDA Returns to the archive 'Issued' folder
Sub CopyToArchive()
Dim strArchiveFolder As String
Dim mbArchive
Dim mbDelete
mbArchive = MsgBox("Do you want to archive the files?" & vbCr & vbCr & _
"This will take some time dependant on your network connection - 30 minutes to 4 hours." & vbCr & vbCr & _
"Click 'Yes' to archive or 'No' to do this manually", vbYesNo, "Archive")
If mbArchive = vbYes Then
strArchiveFolder = "\\Global.lloydstsb.com\file\ResourcePlanningControl\shared\ResourcePlanningControl\FTE Control\Branch\LDA Returns\" & strYear & "\" & strPeriod & "\Issued"
Application.StatusBar = "Copying the LDA Returns file to the archive folder"
objFSO.CopyFolder Source:=strDesktopFolder & "\Issued", Destination:=strArchiveFolder
mbDelete = MsgBox("The files have now been archived" & vbCr & vbCr & _
"Do you want to delete the files from your desktop?", vbYesNo, "Delete Files?")
If mbDelete = vbYes Then
RmDir strDesktopFolder & "\Issued\"
Else
End If
Else
End If
End Sub
Last edited:
