Enable or Disable a macro on the base of a specific user Login

azad092

Board Regular
Joined
Dec 31, 2019
Messages
198
Office Version
  1. 2007
Platform
  1. Windows
Hi
Dear Members
I am using a user form in excel with different user login features. different users have different worksheets access. I have also added a macro in quicke access bar to unhide the hide sheets I want that the macro in quicker access bar should be enable the specific user login otherwise the macro should be disable
part of coding.jpeg

in the image in circle area you can see that if this range of users login then the macro will be enabled
the whole coding is give below
.............
Dim PName As Variant, AName As Variant
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet, ws7 As Worksheet, ws8 As Worksheet, ws9 As Worksheet
Dim result As Integer
Dim TitleStr As String
Dim msg As VbMsgBoxResult

'Variables
user = Me.txtUser.Value
Code = Me.txtPass.Value
TitleStr = "Password check"
result = 0
Set Current = Sheet13.Range("U8")

'Error handler
On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet13.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each AName In Sheet13.Range("Z8:Z108")
'If AName = Code Then 'Use this for passcode text
If AName = CLng(Code) And AName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " " & vbNewLine & "Sajjad you are login as Admin", , "PES RESCUE 1122 MULTAN"
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user
'Change variable if the condition is meet
result = 1
'Unload the form
Sheet13.Visible = True
Sheet13.Select
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next AName
End If

'Check user login with loop
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each PName In Sheet13.Range("H8:H108")
'If PName = Code Then 'Use this for passcode text
If PName = CLng(Code) And PName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " "
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user

'unhide worksheet for user
If PName.Offset(0, 1) <> "" Then
Set ws = Worksheets(PName.Offset(0, 1).Value)
ws.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 2) <> "" Then
Set ws2 = Worksheets(PName.Offset(0, 2).Value)
ws2.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 3) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 3).Value)
ws3.Visible = True
End If
'unhide worksheet for user
If PName.Offset(0, 4) <> "" Then
Set ws4 = Worksheets(PName.Offset(0, 4).Value)
ws4.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 5) <> "" Then
Set ws5 = Worksheets(PName.Offset(0, 5).Value)
ws5.Visible = True
End If
'unhide worksheet for user
If PName.Offset(0, 6) <> "" Then
Set ws6 = Worksheets(PName.Offset(0, 6).Value)
ws6.Visible = True
End If
'unhide worksheet for user
If PName.Offset(0, 7) <> "" Then
Set ws7 = Worksheets(PName.Offset(0, 7).Value)
ws7.Visible = True
End If
'unhide worksheet for user
If PName.Offset(0, 8) <> "" Then
Set ws8 = Worksheets(PName.Offset(0, 8).Value)
ws8.Visible = True
End If
'unhide worksheet for user
If PName.Offset(0, 9) <> "" Then
Set ws9 = Worksheets(PName.Offset(0, 9).Value)
ws9.Visible = True
End If
'show sheet tab if hidden
ActiveWindow.DisplayWorkbookTabs = True

'Change variable if the condition is meet
result = 1
'Unload the form
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next PName
End If

'Check to see if an error occurred
If result = 0 Then
'Increment error variable
Trial = Trial + 1
'Less then 3 error message
If Trial < 3 Then msg = MsgBox("Wrong password, please try again", , "PES RESCUE 1122 MULTAN", vbExclamation + vbOKOnly, TitleStr)
Me.txtUser.SetFocus
'Last chance and close the workbook
If Trial = 3 Then
msg = MsgBox("Wrong password, the form will close…", , "PES RESCUE 1122 MULTAN", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close False
End If
End If
Exit Sub
'Error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator", , "PES RESCUE 1122 MULTAN"
End Sub

Private Sub txtUser_Change()

End Sub

Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
MsgBox "Clicking the Close button does not work."
Cancel = True
End If
End Sub
to enable the macro of unhide sheets is
Sub VisibleTrue()
to enable the macro of hide sheets is
Sub VisibleFalse()
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
I don't think you can enable/disable macros with VBA code. If you could, that would be a HUGE security concern, as you could "force" malicious code on a user.

You could do something like have a Workbook_Open event (that runs when the file is opened) and look up the username and decide if the macros should run for that user or not (maybe set a Global Variable). Then, you could put code at the top of each procedure that exits the code right away if the user is not the correct classification.
 
Upvote 0
I don't think you can enable/disable macros with VBA code. If you could, that would be a HUGE security concern, as you could "force" malicious code on a user.

You could do something like have a Workbook_Open event (that runs when the file is opened) and look up the username and decide if the macros should run for that user or not (maybe set a Global Variable). Then, you could put code at the top of each procedure that exits the code right away if the user is not the correct classification.
thanks dear
 
Upvote 0
You are welcome.

There may be other ways too of accomplishing the same type of thing that I suggested. That was just the first way I thought of.
 
Upvote 0

Forum statistics

Threads
1,214,590
Messages
6,120,421
Members
448,961
Latest member
nzskater

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