How to maintain a distributed VBA Macro with multiple users

D

DrEVMS

New Member
Joined
Sep 14, 2017
Messages
1
I have built an extensive program for my organization which periodically needs to be updated.
I have tried having a macro that deletes all the old macros except itself and then reimports from a central repository but I run into a naming problem.
Source code below. I have reference location in the excel worksheet that it pulls from opens the reference workbook. The macro deletes the old macro and then imports the new. The problem is that even though the old macro has been deleted it still names the file with a two. How do I get it to reset back to the original name.
My go to source has been http://www.cpearson.com/Excel/Topic.aspx
http://what-when-how.com/excel-vba/creating-excel-add-ins/


Code: 
Sub SystemUpdate()
'Defining Variables
    Dim ws As Worksheet, PReference As String
    Dim strPath As String
    Dim Source As Workbook
    Dim Target As Workbook
    Dim VersionSource As Long
    Dim VersionTarget As Long
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim EVMBook As String
    
    'Resets Clipboard to ensure memory space
        Dim clipboard As MSForms.DataObject
        Set clipboard = New MSForms.DataObject
        clipboard.Clear
    
    'Checks if the Auto Update Function is On
    If MainMenu.OnButton = True Then
        Application.DisplayAlerts = False
    
    'System Check for Updates
        'PReference = MainMenu.Range("D34").Value
        EVM = ActiveWorkbook.Name
        Set Target = Workbooks(EVM)
        VersionTarget = Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value
        Workbooks(EVM).Worksheets("Main Menu").Range("D36").Value = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        Targetloc = MainMenu.Range("D36").Value
        
        Call Z_UpdateStorage.SourcePath(1)
        Call Z_UpdateStorage.SourcePath(2)
    'Section 2 Opens Reference File
        
        'MsgBox ("X:\projects\Program_Control\Macros\Program Overview Master Files\" & PReference)
        'Workbooks.Open Filename:=MainMenu.Range("D34").Value
        Reference = MainMenu.Range("D34").Value
        Set Source = Workbooks.Open(Reference)
        Reference = ActiveWorkbook.Name
        VersionSource = Workbooks(Reference).Worksheets("Main Menu").Range("Y4").Value
                
     If VersionSource > VersionTarget Then
        Call ModuleDelete(Target)
'Reimport Modules
    'A_ImportModule
        Const strTextFile = "A_ImportModule.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("A_ImportModule").Export strPath & strTextFile
        Target.VBProject.VBComponents.Import strPath & strTextFile
        Kill strPath & strTextFile
       
    'DataValidation
        Const strTextFile1 = "DataValidation.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("DataValidation").Export strPath & strTextFile1
        Target.VBProject.VBComponents.Import strPath & strTextFile1
        Kill strPath & strTextFile1
        
    'ETCSpreads
        Const strTextFile2 = "ETCSpreads.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("ETCSpreads").Export strPath & strTextFile2
        Target.VBProject.VBComponents.Import strPath & strTextFile2
        Kill strPath & strTextFile2
       
    'ExportModule
        Const strTextFile3 = "ExportModule.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("ExportModule").Export strPath & strTextFile3
        Target.VBProject.VBComponents.Import strPath & strTextFile3
        Kill strPath & strTextFile3
       
    'Format
        Const strTextFile4 = "Formating.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Format").Export strPath & strTextFile4
        Target.VBProject.VBComponents.Import strPath & strTextFile4
        Kill strPath & strTextFile4
        
    'HeadCount
        Const strTextFile5 = "HeadCount.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("HeadCount").Export strPath & strTextFile5
        Target.VBProject.VBComponents.Import strPath & strTextFile5
        Kill strPath & strTextFile5
        
    'LaborData
        Const strTextFile6 = "LaborData.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("LaborData").Export strPath & strTextFile6
        Target.VBProject.VBComponents.Import strPath & strTextFile6
        Kill strPath & strTextFile6
       
    'Report
        Const strTextFile8 = "Report.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Report").Export strPath & strTextFile8
        Target.VBProject.VBComponents.Import strPath & strTextFile8
        Kill strPath & strTextFile8
    
    'Stoplight
        Const strTextFile9 = "Stoplight.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Stoplight").Export strPath & strTextFile9
        Target.VBProject.VBComponents.Import strPath & strTextFile9
        Kill strPath & strTextFile9
'    TPRs
        Const strTextFile10 = "TPRs.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("TPRs").Export strPath & strTextFile10
        Target.VBProject.VBComponents.Import strPath & strTextFile10
        Kill strPath & strTextFile10
       
    'X_ReferenceInfo
        Const strTextFile11 = "X_ReferenceInfo.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
            Source.VBProject.VBComponents("X_ReferenceInfo").Export strPath & strTextFile11
            Target.VBProject.VBComponents.Import strPath & strTextFile11
            Kill strPath & strTextFile11
          
    'X_SystemUpdate
        Const strTextFile12 = "X_SystemUpdate.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("X_SystemUpdate").Export strPath & strTextFile12
        Target.VBProject.VBComponents.Import strPath & strTextFile12
        Kill strPath & strTextFile12
      
    'Program List
      Windows(Reference).Activate
            Sheets("Programs").Select
            Cells.Select
            Selection.Copy
            Windows(EVM).Activate
            Sheets("Programs").Select
            Range("A1").Select
            Sheets("Programs").Paste
            Application.CutCopyMode = False
            Windows(Reference).Activate
            
        'Calendar List
        Windows(Reference).Activate
            Sheets("Net Month Hrs").Select
            Cells.Select
            Selection.Copy
            Windows(EVM).Activate
            Sheets("Net Month Hrs").Select
            Range("A1").Select
            Sheets("Net Month Hrs").Paste
            Application.CutCopyMode = False
            Sheets("Net Month Hrs").Select
            Range("X2").Select
            ActiveCell.FormulaR1C1 = "=VLOOKUP(MONTH('Main Menu'!R[6]C[-12]),'Net Month Hrs'!RC[-5]:R[11]C[-1],5)"
            Range("X11").Select
            ActiveCell.FormulaR1C1 = _
            "=IF(MONTH('Main Menu'!R[-3]C[-12])<10,YEAR('Main Menu'!R[-3]C[-12])&0&MONTH('Main Menu'!R[-3]C[-12]),YEAR('Main Menu'!R[-3]C[-12])&MONTH('Main Menu'!R[-3]C[-12]))"
            Sheets("Main Menu").Select
            Range("L30").Select
            ActiveCell.FormulaR1C1 = _
            "=IF(R[-16]C-R[-16]C[-8]=R[-20]C,VLOOKUP(R[-16]C[-8]+R[-20]C,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2,VLOOKUP(R[-16]C[-8]-1,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2)"
            Windows(Reference).Activate
          
      Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value = VersionSource
      Source.Close
    
    Updated = True
    
    Exit Sub
    
    Else
       Source.Close
       Updated = False
       Call MessageBoxTimer
    End If
    Application.DisplayAlerts = True
ElseIf MainMenu.OffButton = True Then
    Ignore = MsgBox("The Following Updates will not be installed", vbOKCancel, "Ignore Auto Update")
    NameUpdate = False
End If
End Sub
Sub PrepReferenceFile()
Application.DisplayAlerts = False
For Each wsa In Worksheets
    If wsa.Name <> "Main Menu" And wsa.Name <> "User Directions" _
        And wsa.Name <> "Programs" And wsa.Name <> "Net Month Hrs" _
        And wsa.Name <> "Modules Definitions" And wsa.Name <> "RevisionLog" _
        And wsa.Name <> "References" And wsa.Name <> "Modules" Then wsa.Delete
Next
Application.DisplayAlerts = True
End Sub
Sub Rename()
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_SystemUpdate1")
        VBCodMod2.Name = "X_SystemUpdate"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("a_ImportModule1")
        VBCodMod2.Name = "a_ImportModule"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("DataValidation1")
        VBCodMod2.Name = "DataValidation"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_ReferenceInfo1")
        VBCodMod2.Name = "X_ReferenceInfo"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("Report1")
        VBCodMod2.Name = "Report"
End Sub
Sub MessageBoxTimer()
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 5
    Select Case InfoBox.Popup("File is Up to Date", _
    AckTime, "This is your Message Box", 0)
        Case 1, -1
            Exit Sub
    End Select
End Sub
Sub ModuleDelete(Target As Workbook)
'A_ImportModule
        With Target.VBProject.VBComponents
            .Remove .Item("A_ImportModule")
        End With
'DataValidation
           With Target.VBProject.VBComponents
            .Remove .Item("DataValidation")
        End With
'ETCSpreads
        With Target.VBProject.VBComponents
            .Remove .Item("ETCSpreads")
        End With
'ExportModule
        With Target.VBProject.VBComponents
            .Remove .Item("ExportModule")
        End With
'Format
        With Target.VBProject.VBComponents
            .Remove .Item("Format")
        End With
'HeadCount
        With Target.VBProject.VBComponents
            .Remove .Item("HeadCount")
        End With
'LaborData
        With Target.VBProject.VBComponents
            .Remove .Item("LaborData")
        End With
'Report
        With Target.VBProject.VBComponents
            .Remove .Item("Report")
        End With
'Stoplight
        With Target.VBProject.VBComponents
            .Remove .Item("Stoplight")
        End With
'TPRs
        With Target.VBProject.VBComponents
            .Remove .Item("TPRs")
        End With
'X_ReferenceInfo
        With Target.VBProject.VBComponents
            .Remove .Item("X_ReferenceInfo")
        End With
'X_SystemUpdate
         With Target.VBProject.VBComponents
            .Remove .Item("X_SystemUpdate")
        End With
Exit Sub
End Sub

<tbody>
</tbody>
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
You must log in or register to reply here.

Similar threads

D
  • Question
Why does Excel run slowly / unresponsively AFTER this macro has completed successfully?
2
Replies
14
Views
11K
derekpegg
D

Forum statistics

Threads
1,215,730
Messages
6,126,528
Members
449,316
Latest member
sravya

Share this page

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