Why does this macro work for my colleague but not me?

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.


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
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Can't you debug the macro and add some breaks in the macro to see until where it's okay ?
It's difficult to search for a minor difference ?
 
Upvote 0
you do appear to have a couple of things which aren't defined within this code both of which might be different on your computer. ( have no idea what either of them are) :
the data type :clsAppSettings
and the function : GNR
 
Upvote 0
I had the same issue recently, looking for ages to fix it and eventually discovered the laptop was running Windows 10 in S mode was the only difference between a laptop running the macro and not so changed it out of S mode ,opened the excel file and ran the macros. It worked for me. I did look at trust setting as well just like you to no joy.
 
Upvote 0
you do appear to have a couple of things which aren't defined within this code both of which might be different on your computer. ( have no idea what either of them are) :
the data type :clsAppSettings
and the function : GNR
Thanks you for your reply, this is the clsAppSettings class module

VBA Code:
'Author:    Zorro
'Date:      11/10/2016
'Version:   1.1
'Notes:     Amended to include setting of global variable blnDisableEvents (in preference to .EnableEvents) so that modal userforms behave properly in SDI!

'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     This class is used to set/return the application settings in each procedure.

Option Explicit

Public cStatusBar As Variant
Public cEnableEvents As Boolean
Public cScreenUpdating As Boolean
Public cDisplayAlerts As Boolean
Public cCalculation As XlCalculation
Public cCursor As XlMousePointer

Private blnSetByUser As Boolean

Public Sub RecordSettings()
'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     Records the current settings

With Application
    cStatusBar = .StatusBar
    cEnableEvents = .EnableEvents
    cScreenUpdating = .ScreenUpdating
    cDisplayAlerts = .DisplayAlerts
    cCursor = .Cursor
    If CountOpenVisibleWorkbooks_ <> 0 Then cCalculation = .Calculation
End With

End Sub

Public Sub ReturnSettings()
'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     Returns the settings to whatever they were saved as but only if they've been set at least once by the caller

If blnSetByUser Then
    With Application
        If cStatusBar = "FALSE" Then
            .StatusBar = False
        Else
            .StatusBar = cStatusBar
        End If
        .EnableEvents = cEnableEvents
        .ScreenUpdating = cScreenUpdating
        .DisplayAlerts = cDisplayAlerts
        .Cursor = cCursor
        If CountOpenVisibleWorkbooks_ <> 0 Then .Calculation = cCalculation
    End With
End If

End Sub

Public Sub SetSettings(strStatusBar As Variant, _
                        blnEnableEvents As Boolean, _
                        blnScreenUpdating As Boolean, _
                        blnDisplayAlerts As Boolean, _
                        xlmCursor As XlMousePointer, _
                        xlCalc As XlCalculation)
'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     Sets the application settings to whatever the caller wants

blnSetByUser = True

With Application
    .StatusBar = strStatusBar
    .EnableEvents = blnEnableEvents
    .ScreenUpdating = blnScreenUpdating
    .DisplayAlerts = blnDisplayAlerts
    .Cursor = xlmCursor
    If CountOpenVisibleWorkbooks_ <> 0 Then .Calculation = xlCalc
End With

End Sub

Public Sub TurnAllOff_WaitCursor()
'Author:    Zorro
'Date:      20/07/2012
'Version:   1.0
'Notes:     Sets the application settings all be 'off' (most commonly used)

Call RecordAndSetSettings(False, False, False, False, xlWait, xlCalculationManual)

End Sub

Public Sub TurnAllOff_DefaultCursor()
'Author:    Zorro
'Date:      20/07/2012
'Version:   1.0
'Notes:     Sets the application settings all be 'off' (most commonly used)

Call RecordAndSetSettings(False, False, False, False, xlDefault, xlCalculationManual)

End Sub

Public Sub RecordAndSetSettings(strStatusBar As Variant, _
                        blnEnableEvents As Boolean, _
                        blnScreenUpdating As Boolean, _
                        blnDisplayAlerts As Boolean, _
                        xlmCursor As XlMousePointer, _
                        xlCalc As XlCalculation)
'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     Records the current settings and sets them to what the caller wants - saves an extra line of code in the caller

blnSetByUser = True

With Application
    cStatusBar = .StatusBar
    cEnableEvents = .EnableEvents
    cScreenUpdating = .ScreenUpdating
    cDisplayAlerts = .DisplayAlerts
    cCursor = .Cursor
    If CountOpenVisibleWorkbooks_ <> 0 Then cCalculation = .Calculation

    .StatusBar = strStatusBar
    .EnableEvents = blnEnableEvents
    .ScreenUpdating = blnScreenUpdating
    .DisplayAlerts = blnDisplayAlerts
    .Cursor = xlmCursor
    If CountOpenVisibleWorkbooks_ <> 0 Then .Calculation = xlCalc
End With
                        
End Sub

Public Sub ResetSettingsToDefault()
'Author:    Zorro
'Date:      29/07/2009
'Version:   1.0
'Notes:     Resets the application settings to a 'default' setting


With Application
    .StatusBar = False
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Cursor = xlDefault
    If CountOpenVisibleWorkbooks_ <> 0 Then .Calculation = xlCalculationAutomatic
End With

End Sub


Private Function CountOpenVisibleWorkbooks_() As Integer

Dim wbkW As Workbook
Dim i As Integer
Dim intcount As Integer

For Each wbkW In Application.Workbooks
    For i = 1 To wbkW.Windows.Count
        If wbkW.Windows(i).Visible Then
            intcount = intcount + 1
            Exit For
        End If
    Next i
Next wbkW

CountOpenVisibleWorkbooks_ = intcount

End Function
 
Upvote 0
you do appear to have a couple of things which aren't defined within this code both of which might be different on your computer. ( have no idea what either of them are) :
the data type :clsAppSettings
and the function : GNR
And just found what GNR refers to.

VBA Code:
Public Function GNR(strName As String, Optional wbkTarget As Workbook = Nothing) As Range
'Gets a Named Range as range - shorter than Thisworkbook.names("XXX").RefersToRange

If wbkTarget Is Nothing Then Set wbkTarget = ThisWorkbook

On Error GoTo err_trap

Set GNR = wbkTarget.Names(strName).RefersToRange

On Error GoTo 0

err_trap:
Err.Clear

End Function
 
Upvote 0
Have you checked whether these two function are identical on your colleagues machine??
 
Upvote 0
No, I thought because they were just from different modules in the same workbook that they were the same.

It's the exact same workbook and all the paths are the same... so yeah It's a real humdinger.
 
Upvote 0
Alright so finally just figured it out. It was an issue with the query connection not the VBA/Macro.

Excel)Data)Get Data)Query Options)Privacy) [I was on “combine data according to each file’s…” and my colleague was on “Always ignore Privacy Level Settings”]


query.PNG
 
Upvote 0
Solution

Forum statistics

Threads
1,224,813
Messages
6,181,107
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top