Silverjman
Board Regular
- Joined
- Mar 19, 2014
- Messages
- 110
We have the same computer, and same Excel version "Excel for Microsoft 365 (Version 2202 Build 16.0.14931.20128) 64-bit".
I am new to the company so we thought it might be something to do with my Trust Settings, but having trusted every location and file that hasn't changed anything.
I don't get any errors and the macro runs for ~5 minutes but when it completes for him my colleague has updated numbers and when I run it I still have the same old unupdated ones.
I am new to the company so we thought it might be something to do with my Trust Settings, but having trusted every location and file that hasn't changed anything.
I don't get any errors and the macro runs for ~5 minutes but when it completes for him my colleague has updated numbers and when I run it I still have the same old unupdated ones.
VBA Code:
Sub GenerateCSVsNonRollforward()
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
StartTime = Timer
' Record user settings and set settings that we want
Dim nxtApp As New clsAppSettings
nxtApp.RecordAndSetSettings False, False, False, False, xlWait, xlCalculationManual
Dim rngFolderLocationTable As Range
Dim rngUserIndex As Range
Dim rngAVMOutputRange As Range
Dim strAVMFolderLocationNameLUP As String
Dim strCSVFolderLocationNameLUP As String
Dim strAVMFolderLocationNamePUP As String
Dim strCSVFolderLocationNamePUP As String
Dim rngModelVersion As Range
Dim c As Range
Dim wbk As Workbook
Dim wbkNew As Workbook
Dim FSOLibrary As Object
Dim FSOFolderLUP As Object
Dim FSOFolderPUP As Object
Dim FSOFolderLUPAVM As Object
Dim strFileNameLUP As Object
Dim strFileNamePUP As Object
Dim strFileNameLUPAVM As Object
Dim strFileNameLUPAVM2 As String
Dim wbTarget As Workbook
Dim xStrDate As String
Dim i As Integer
Dim rngPassword As Range
Dim strCountPath As String
Dim strAVMOutputCashflowNamedRange As String
Dim strAssetNameNamedRange As String
Dim ansAVM As Variant
Dim rngTimestamp As Range
Dim rngNameStamp As Range
Dim varArchive As VbMsgBoxResult
Dim varCancel As VbMsgBoxResult
Dim rngDatestamp As Range
Dim varQuarterStamp As Variant
Dim boolQuarterStamp As Boolean
Dim rngCurrencyInput As Range
Dim rngCurrencyList As Range
Set rngFolderLocationTable = GNR("pq.FolderLocationsTable", ThisWorkbook)
Set rngUserIndex = GNR("vba.UserIndex", ThisWorkbook)
Set rngPassword = GNR("vba.PasswordLUP", ThisWorkbook)
Set rngTimestamp = GNR("vba.TimestampLUP", ThisWorkbook)
Set rngNameStamp = GNR("vba.LastUserLUP", ThisWorkbook)
Set rngDatestamp = GNR("vba.DateStampLUP", ThisWorkbook)
strAVMFolderLocationNameLUP = WorksheetFunction.Index(rngFolderLocationTable, rngUserIndex + 1, 6)
strCSVFolderLocationNameLUP = WorksheetFunction.Index(rngFolderLocationTable, rngUserIndex + 1, 7)
strAVMFolderLocationNamePUP = WorksheetFunction.Index(rngFolderLocationTable, rngUserIndex + 1, 4)
strCSVFolderLocationNamePUP = WorksheetFunction.Index(rngFolderLocationTable, rngUserIndex + 1, 5)
xStrDate = Format(Now, "yy mm dd hh mm")
strAVMOutputCashflowNamedRange = GNR("vba.AVMOutputCashflowNamedRange", ThisWorkbook).Value
strAssetNameNamedRange = GNR("vba.AVMAssetNameNamedRange", ThisWorkbook).Value
varCancel = MsgBox("This will delete the current CSV data for the current AVM results and not archive them" & vbNewLine & _
"Do you want to continue?", Buttons:=vbYesNoCancel, Title:="Continue")
Select Case varCancel
Case vbYes
Case vbNo
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
Case vbCancel
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
End Select
'Ensure that the used folders exist
If Not FolderExists(strAVMFolderLocationNameLUP) Or strAVMFolderLocationNameLUP = "" Or _
Not FolderExists(strCSVFolderLocationNameLUP) Or strCSVFolderLocationNameLUP = "" Or _
Not FolderExists(strCSVFolderLocationNamePUP) Or strCSVFolderLocationNamePUP = "" Then
MsgBox "Please ensure that the LUP & PUP AVM folder locations and LUP & PUP CSV folder locations are input into the table and exist in your documents." & _
vbNewLine & vbNewLine & "Have you selected the correct user profile?"
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
End If
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolderLUP = FSOLibrary.GetFolder(strCSVFolderLocationNameLUP)
Set FSOFolderPUP = FSOLibrary.GetFolder(strCSVFolderLocationNamePUP)
Set FSOFolderLUPAVM = FSOLibrary.GetFolder(strAVMFolderLocationNameLUP)
' Check all AFM named range inputs are populated
If strAVMOutputCashflowNamedRange = "" Then
' End sub and tell user and reset settings
MsgBox "The following named range is blank: vba.AVMOutput." & vbNewLine & vbNewLine & _
"The named range is in cell " & GNR("vba.AVMOutputCashflowNamedRange", ThisWorkbook).Address & " and is on the " & GNR("vba.AVMOutputCashflowNamedRange", ThisWorkbook).Parent.Name & " sheet." _
& vbNewLine & vbNewLine & "The AVM import process cannot continue. Please make sure the above named range is not blank and then re-run the process." _
, vbOKOnly, "Named range missing"
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
ElseIf strAssetNameNamedRange = "" Then
' End sub and tell user and reset settings
MsgBox "The following named range is blank: C.DealID." & vbNewLine & vbNewLine & _
"The named range is in cell " & GNR("vba.AVMAssetNameNamedRange", ThisWorkbook).Address & " and is on the " & GNR("vba.AVMAssetNameNamedRange", ThisWorkbook).Parent.Name & " sheet." _
& vbNewLine & vbNewLine & "The AVM import process cannot continue. Please make sure the above named range is not blank and then re-run the process." _
, vbOKOnly, "Named range missing"
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
End If
'Check to ensure that there are AVMs in the LUP AVM folder
i = 0
For Each strFileNameLUPAVM In FSOFolderLUPAVM.Files
i = i + 1
Next strFileNameLUPAVM
If i = 0 Then
MsgBox "There are no AVMs in the following folder:" & vbNewLine & strAVMFolderLocationNameLUP & vbNewLine & _
"Ensure that you have AVMs in this folder", vbOKOnly, "AVMs missing"
Application.StatusBar = False
nxtApp.ReturnSettings
Exit Sub
End If
'Delete all previous CSVs in LUP folder
'Check to ensure there are CSVs in the LUP CSV folder
i = 0
For Each strFileNameLUP In FSOFolderLUP.Files
i = i + 1
Next strFileNameLUP
If i > 0 Then 'Delete files from LUP CSV folder
i = 1
strCountPath = Dir(strCSVFolderLocationNameLUP & "\*.csv")
Do While strCountPath <> ""
i = i + 1
strCountPath = Dir()
Loop
If i > 1 Then
Kill strCSVFolderLocationNameLUP & "\" & "*.csv*"
End If
Else
'There are no CSVs in the LUP folder to be deleted so move on
End If
'Loop through AVMs and create new CSVs
i = 1
For Each strFileNameLUPAVM In FSOFolderLUPAVM.Files
Application.StatusBar = "Creating CSV for " & strFileNameLUPAVM.Name
Debug.Print strFileNameLUPAVM.Name
Set wbTarget = Workbooks.Open(FileName:=strFileNameLUPAVM, Password:=rngPassword)
wbTarget.Activate
ActiveWindow.Visible = False
'Check all ranges are in the target AFM
If NameExists(strAVMOutputCashflowNamedRange, wbTarget) = False Or NameExists(strAssetNameNamedRange, wbTarget) = False Then
ansAVM = MsgBox("We are currently try to import the data from the following AVM file: " & wbTarget.Name & vbNewLine & vbNewLine & _
"One of the following five names is missing from this AFM: " & vbNewLine & strAVMOutputCashflowNamedRange & vbNewLine & strAssetNameNamedRange _
& vbNewLine & vbNewLine & "Would you like to continue the AVM import process but skip this file? Clicking no will exit the process.", vbYesNo)
If ansAVM = vbNo Then
Application.StatusBar = False
wbTarget.Close False
nxtApp.ReturnSettings
Exit Sub
ElseIf ansAVM = vbYes Then
GoTo SkipAFMFile
End If
End If
Set rngAVMOutputRange = GNR(strAVMOutputCashflowNamedRange, wbTarget)
Set rngModelVersion = GNR(strAssetNameNamedRange, wbTarget)
Set rngCurrencyInput = GNR("L.ValUnit", wbTarget)
Set rngCurrencyList = GNR("Li.Units", wbTarget)
Debug.Print rngCurrencyList.Cells(1, 1).Value
rngCurrencyInput.Value = rngCurrencyList.Cells(1, 1).Value
Application.Calculate
Set wbkNew = Workbooks.Add
rngAVMOutputRange.Copy
wbkNew.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
wbkNew.SaveAs FileName:=strCSVFolderLocationNameLUP & "\" & "Csv_" & rngModelVersion.Value & "_" & i & "_" & rngDatestamp.Value & "_" & xStrDate & ".csv", FileFormat:=xlCSV, CreateBackup:=False 'FileFormat:=.xlCSVMSDOS
wbkNew.Save
wbkNew.Close
wbTarget.Close
SkipAFMFile:
i = i + 1
Next strFileNameLUPAVM
'Move AVMs from LUP folder to archive folder
'Check if Archive folder exists already in LUP AVM folder
If Not FSOLibrary.FolderExists(strAVMFolderLocationNameLUP & "\" & "ExcelAVMs Archive") Then
'Add new folder
FSOLibrary.createfolder (strAVMFolderLocationNameLUP & "\" & "ExcelAVMs Archive")
End If
'Check to ensure there are AVMs in the LUP folder
i = 0
For Each strFileNameLUPAVM In FSOFolderLUPAVM.Files
i = i + 1
Next strFileNameLUPAVM
If i > 0 Then 'Copy AVM files from LUP AVM folder to AVM archive folder
For Each strFileNameLUPAVM In FSOFolderLUPAVM.Files
If InStr(strFileNameLUPAVM, ".xlsm") Then
strFileNameLUPAVM2 = Replace(strFileNameLUPAVM, ".xlsm", "")
End If
'FSOLibrary.Copyfile Source:=strFileNameLUPAVM, Destination:=strAVMFolderLocationNameLUP & "\" & "ExcelAVMs Archive\" & FSOLibrary.GetFileName(strFileNameLUPAVM2) & "_" & Replace(CStr(rngDatestamp.Value), "_", "") & ".xlsm"
FSOLibrary.Copyfile Source:=strAVMFolderLocationNameLUP & "\*.xlsm", Destination:=strAVMFolderLocationNameLUP & "\" & "ExcelAVMs Archive"
Next strFileNameLUPAVM
Else
'There are no AVMs in the LUP AVM folder to move to AVM archive folder, so skip 'movefile' step
End If
' Return all the settings back to normal before refreshing queries
nxtApp.ReturnSettings
' Record the settings again as we want to set a couple of manual settings for the refresh - events = TRUE and calc = Auto
nxtApp.RecordSettings
' Update the AFM data model
Call RefreshQueries
'Release the memory
Set FSOLibrary = Nothing
Set FSOFolderLUP = Nothing
Set FSOFolderPUP = Nothing
Set FSOFolderLUPAVM = Nothing
'Timestamp
rngTimestamp.Value = Now()
'Namestamp
rngNameStamp.Value = Environ("UserName")
'Adjust asset table
Call AddRemoveRowsAssetsTable
' Return the settings back to what the user originally had
Application.StatusBar = False
nxtApp.ReturnSettings
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Done in " & SecondsElapsed & " seconds."
End Sub