Running a different macro or code part by different user

Question

I wrote a macro to save a file onto a specific URL. The problem is that the macro is run by different users in my company with different levels of permission to access to the intranet's folders. The macro is activated by a button on the spreadsheet. As far as I know I have at least 2 solutions:

Create different macros and link them to different buttons(users will press their respective. Not elegant-possibility to get in error)
Make VBA recognise the user and run a specific macro or code string with the correct SAVE AS url. I'd avoid the first solution, but I don't know how to write the second.

Here's the entire code with the path in SAVE AS method:

Sub test_salva()

Workbooks.Open Filename:= _
    "\\Share\Qualita_MG\Gestione Documentazione\Doc. TECNICI-  QUALITA'\Moduli di supporto\C - Controllo Qualita'\MOD UNICO.xlsm"
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
  Do While Not IsEmpty(ActiveCell)
  ActiveCell.Offset(1, 0).Select
  Loop
  ActiveCell.Offset(-1, 0).Select

Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AF31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("R2").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD4").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
progressivo = Range("AF31")
nomefile = Range("B5")
ActiveWorkbook.SaveAs Filename:= _"\\Share\Qualita_MG\Documentazione  registrazione\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" & nomefile _ 
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 
     Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
variabile = Selection
nome = ActiveCell.Range("c1")
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm",   TextToDisplay:=nome

ActiveCell.Offset(1, -2).Range("A1").Select

End Sub

Also a lot on SO using active directory at [http://stackoverflow.com/questions/7805856/vba-retrieve-the-name-of-the-user-associated-with-logged-username — MiguelH, Sep 30 '15 at 13:42
I would start by familiarizing myself with the [Environ function](https://msdn.microsoft.com/en-us/library/office/gg264486.aspx?f=255&MSPPError=-2147217396) and the [Select Case statement](https://msdn.microsoft.com/en-us/library/office/gg278665.aspx). — , Sep 30 '15 at 13:53
Also, don't use ".Select" and "Selection" so much. https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?s=1|212.0759 — Shawn V. Wilson, Jun 15 '18 at 22:28

score 0 · Answer 1 · answered Oct 01 '15 at 08:03

I'd like to post the solution to my issue:

Sub test_salva()

**If Application.UserName = "Manuela Frignani" Then GoTo line1 Else GoTo         line2**

**line1:**
Workbooks.Open Filename:= _
    "Z:\Certificati SERIE\2015\MOD UNICO.xlsm"
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
  Do While Not IsEmpty(ActiveCell)
  ActiveCell.Offset(1, 0).Select
  Loop
  ActiveCell.Offset(-1, 0).Select

Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AF31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("R2").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD4").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
progressivo = Range("AF31")
nomefile = Range("B5")
ActiveWorkbook.SaveAs Filename:= _
    "Z:\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" &  nomefile _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 
     Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
variabile = Selection
nome = ActiveCell.Range("c1")
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm",    TextToDisplay:=nome
With Selection.Font
    .Name = "Calibri Light"
    .Size = 17.6
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleSingle
    .ThemeColor = xlThemeColorHyperlink
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
Selection.Font.Size = 16
Selection.Font.Size = 14
Selection.Font.Size = 12
Selection.Font.Size = 11
Selection.Font.Size = 10
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0.499984740745262
End With
ActiveCell.Offset(1, -2).Range("A1").Select
GoTo line3


**line2:**
Workbooks.Open Filename:= _
    "\\Share\Qualita_MG\Gestione Documentazione\Doc. TECNICI- QUALITA'\Moduli di supporto\C - Controllo Qualita'\MOD UNICO.xlsm"
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
  Do While Not IsEmpty(ActiveCell)
  ActiveCell.Offset(1, 0).Select
  Loop
  ActiveCell.Offset(-1, 0).Select

Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AF31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks  _
    :=False, Transpose:=False

Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("R2").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD4").Select
ActiveSheet.Paste
Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("MOD UNICO.xlsm").Activate
Sheets("Ita-Eng").Activate
Range("AD5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
progressivo = Range("AF31")
nomefile = Range("B5")
ActiveWorkbook.SaveAs Filename:= _
    "\\Share\Qualita_MG\Documentazione registrazione\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" & nomefile _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 
     Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate
ActiveSheet.Range("A3").Select
Do While Not IsEmpty(ActiveCell)
  ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
variabile = Selection
nome = ActiveCell.Range("c1")
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm",  TextToDisplay:=nome
With Selection.Font
    .Name = "Calibri Light"
    .Size = 17.6
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleSingle
    .ThemeColor = xlThemeColorHyperlink
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
 End With
    Selection.Font.Size = 16
    Selection.Font.Size = 14
    Selection.Font.Size = 12
    Selection.Font.Size = 11
    Selection.Font.Size = 10
    Selection.Font.Underline = xlUnderlineStyleNone
    Selection.Font.Underline = xlUnderlineStyleSingle
With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0.499984740745262
End With
    ActiveCell.Offset(1, -2).Range("A1").Select

**line3:**

End Sub

Running a different macro or code part by different user

1 Answers1