PDA

View Full Version : Solved: set password on command button for macro



almouchie
01-06-2006, 06:53 AM
i have written a macro & assigned a command button to it

is there a way to set a password for that command button as not to allow any1 to run the macro & change the data

i didnt find anything in the command button properties to enable to lock it
I tried to protect the sheet but it allows clicking the command button
any ideas
thanks

mvidas
01-06-2006, 07:04 AM
Hello,

Assuming you're locking the VBA project so people can't see your code as well, you could put something like this in the beginning of your macro:Private Sub CommandButton1_Click()
Dim ThePW As String
ThePW = InputBox("A password is required to run this procedure." & vbCrLf & _
"Please enter the password:", "Password")
If ThePW <> "your password goes here" Then Exit Sub
'Rest of your code
End SubMatt

almouchie
01-07-2006, 11:45 AM
that gave me a new command button with password
i already have a button & a code assigned to it
how can i link the two so as to be able to only run the macro when a password id entered
where do i lock my VBA code

thanks

Ken Puls
01-07-2006, 02:10 PM
where do i lock my VBA code

In the VBE, go to Tools|VBAProject Properties|Protection

Click the "Lock Project for Viewing" button and give it a password. Just make sure that you aren't going to forget it, as it can't be recovered, AFAIK.

FYI, though, don't be under the impression that no one will ever be able to review your code. While it can't be recovered, it CAN be hacked. It will stop 99% of users out there, but if you're up against an experienced coder who is determined to get in, they can. If they're that good though, and that malicious, you've probably got other things to worry about though anyway.

:)

tpoynton
01-07-2006, 08:05 PM
are you looking for the command button to be enabled only when the correct password is entered? for that, you can use the .enabled property. set the commandbutton property to false in the VBE, then you can use the password textbox onchange event to enable the commandbutton (commandbutton.enabled = true).

if this isnt clear, post your workbook with a fake password (or what you have so far) and i am sure you will find the help you need here...

almouchie
01-08-2006, 07:18 AM
thanks for ur replies
yes all i want is to set a password so command button will work & macro runs if the password is entered

how do i do that
enable command button to false

Ken Puls
01-08-2006, 06:16 PM
thanks for ur replies
yes all i want is to set a password so command button will work & macro runs if the password is entered

Matt (mvidas) gave you the exact code you need to accomplish this task in his response. Do you need help implementing it? If so, where are you having issues?

tpoynton
01-08-2006, 06:59 PM
again, for anyone to help you further, you will need to provide a workbook (ideally) or the current code you are working with. the answers to your questions are in this thread, so as kpuls suggests, the problem is with implementation, which is most easily addressed in the context of the code you currently are working with...

almouchie
01-09-2006, 01:05 AM
thanks for ur reply
i have a command button & below is the macro

Sub CopyInsertSheet()
Dim iCol As Integer, iColEnd As Integer
Dim lRow As Long
Dim rMaster As Range, R As Range
Dim sCur As String, sMess As String
Dim wsMaster As Worksheet
Dim wsTarget As Worksheet

Set wsMaster = Sheets("Master")
Set rMaster = wsMaster.Range("b3:b" & wsMaster.UsedRange.Rows.Count)

iColEnd = wsMaster.UsedRange.Columns.Count

'***************************************
'** first ensure that all sheets exist **
'***************************************

For Each R In rMaster
sCur = R.Text
On Error Resume Next

Set wsTarget = Sheets(sCur)

If Err.Number > 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Err.Number = 0
Sheets(Sheets.Count).Name = sCur

If Err.Number > 0 Then
MsgBox "Row " & R.Row & " has an illegal character in the name." & vbCrLf & _
"Please correct."
Exit Sub
End If
End If

On Error GoTo 0
Next R

'*******************************************
'** Loop thru all entries in Master sheet **
'*******************************************

For Each R In rMaster
sCur = R.Text

Set wsTarget = Sheets(sCur)

lRow = wsTarget.Range("A65536").End(xlUp).Row + 1

For iCol = 1 To iColEnd
wsTarget.Cells(lRow, iCol).FormulaR1C1 = "='" & wsMaster.Name & _
"'!R" & R.Row & "C" & iCol
Next iCol
Next R
End Sub


when i used matt's code it made a new button & asked for a password i didnt yet supply
i want my code to be password protected so as not to click the macro unless they have the password
i hope i made myself clear & didnt get u all confused again
thanks for ur help

tpoynton
01-09-2006, 06:15 AM
Matt's code is set up for you to put your password in the spot where it currently says "your password goes here". Regarding locking the project for viewing, kpuls instructions are pretty clear.

While i appreciate your posting the code here, it would be abundantly easier and more clear to all if you post your entire workbook...see, I have been working from my biased assumption that the commandbutton is on a userform - after more review, i see that it is not. posting your workbook will allow everyone to be crystal clear about what you are working with, and facilitate a solution to your problem...

almouchie
01-09-2006, 07:28 AM
thats is the whole VBA

Sub CopyInsertSheet()
Dim iCol As Integer, iColEnd As Integer
Dim lRow As Long
Dim rMaster As Range, R As Range
Dim sCur As String, sMess As String
Dim wsMaster As Worksheet
Dim wsTarget As Worksheet
Set wsMaster = Sheets("Master")
Set rMaster = wsMaster.Range("b3:b" & wsMaster.UsedRange.Rows.Count)
iColEnd = wsMaster.UsedRange.Columns.Count
'***************************************
'** first ensure that all sheets exist **
'***************************************
For Each R In rMaster
sCur = R.Text
On Error Resume Next
Set wsTarget = Sheets(sCur)
If Err.Number > 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Err.Number = 0
Sheets(Sheets.Count).Name = sCur
If Err.Number > 0 Then
MsgBox "Row " & R.Row & " has an illegal character in the name." & vbCrLf & _
"Please correct."
Exit Sub
End If
End If
On Error GoTo 0
Next R
'*******************************************
'** Loop thru all entries in Master sheet **
'*******************************************
For Each R In rMaster
sCur = R.Text
Set wsTarget = Sheets(sCur)
lRow = wsTarget.Range("A65536").End(xlUp).Row + 1
For iCol = 1 To iColEnd
wsTarget.Cells(lRow, iCol).FormulaR1C1 = "='" & wsMaster.Name & _
"'!R" & R.Row & "C" & iCol
Next iCol
Next R
End Sub
Sub Move2()
'Standard Module code, like: Module1!
'This code Shows all sheet names & asks the user for a new Sheet name.
'Then selects the Sheet with the users inputed name.
Dim mySheet%, mySName$, i%
Dim mySList$, myPrompt$
Dim wks As Worksheet
On Error GoTo myErr
mySName = ActiveSheet.Name
For Each wks In Worksheets
i = i + 1
mySList = mySList & i & ". " & wks.Name & ", "
Next wks
myPrompt = "The Active Sheet is: " & _
mySName & vbCr & vbCr & mySList
mySheet = Application.InputBox(prompt:=myPrompt, _
Title:="Select a Sheet's ""Item Number!""", Type:=1 + 2 + 64)
If mySheet = False Or mySheet = xlNull Then
mySheet = 0
GoTo myEnd
End If
If mySheet <> 0 Then
'Sheets.Add.Name = mySheet
Worksheets(mySheet).Select
End If
GoTo myEnd
myErr:
MsgBox "You did not enter a sheet's ""Item Number"" or hit ""Cancel!"""
myEnd:
End Sub

Sub CopyPlanningSheet2MasterSheet_Click()

Sheets("master").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=planning!RC"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[4]"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[1]"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[-2]"
Range("E3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[64]"
Range("F3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[-3]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[66]"
Range("H3").Select
ActiveCell.FormulaR1C1 = "=planning!RC[76]"
Range("I3").Select
ActiveCell.FormulaR1C1 = ""
Range("I3").Select
Sheets("planning").Select
Cells.Select
Range("G1").Activate
Cells.EntireColumn.AutoFit
Columns("M:X").Select
Range("M2").Activate
Selection.ColumnWidth = 8.57
Selection.ColumnWidth = 11.86
Columns("M:M").Select
Range("M2").Activate
Columns("K:K").ColumnWidth = 8.14
Columns("L:X").Select
Selection.EntireColumn.Hidden = True

Columns("H:H").Select
Selection.EntireColumn.Hidden = True
Columns("I:I").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=12
Columns("AC:BL").Select
Range("AC2").Activate
Columns("AC:BL").EntireColumn.AutoFit
Selection.ColumnWidth = 9.71
ActiveWindow.SmallScroll ToRight:=11
Columns("BM:BP").Select
Selection.EntireColumn.Hidden = True
Range("BT3").Select

Sheets("planning").Select
ActiveWindow.SmallScroll ToRight:=13
Range("AE3").Select
ActiveWindow.SmallScroll ToRight:=3
Columns("AO:AR").Select
Range("AO2").Activate
Selection.ColumnWidth = 11.57
ActiveWindow.SmallScroll ToRight:=4
Selection.ColumnWidth = 16.14
Range("AQ1:AR2").Select
ActiveWindow.SmallScroll ToRight:=4
Columns("AS:AZ").Select
Range("AS2").Activate
Selection.ColumnWidth = 12.43
Range("AY3").Select

Columns("AW:BL").Select
Range("AW2").Activate
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=-18
Columns("Z:AB").Select
Range("AB1").Activate
Selection.NumberFormat = "#,##0.00"
Selection.ColumnWidth = 20
ActiveWindow.SmallScroll ToRight:=-2
Columns("Y:Y").Select
Selection.ColumnWidth = 20
Selection.NumberFormat = "#,##0.00"
Columns("Y:AB").Select
Selection.ColumnWidth = 13.14
Range("AC3").Select
Sheets("master").Select
ActiveCell.FormulaR1C1 = _
"=planning!RC[20]+planning!RC[22]+planning!RC[32]+planning!RC[34]"
Range("J3").Select
ActiveCell.FormulaR1C1 = _
"=planning!RC[20]+planning!RC[22]+planning!RC[32]+planning!RC[34]"
Range("K3").Select
ActiveCell.FormulaR1C1 = _
"=planning!RC[22]+planning!RC[24]+planning!RC[34]+planning!RC[36]"
Range("L3").Select
ActiveCell.FormulaR1C1 = _
"=planning!RC[22]+planning!RC[24]+planning!RC[34]+planning!RC[36]"
Range("M3").Select
ActiveWindow.ScrollColumn = 4
Columns("K:L").Select
Selection.ColumnWidth = 12
Columns("I:J").Select
Selection.ColumnWidth = 15
Columns("K:L").Select
Selection.ColumnWidth = 15
ActiveWindow.SmallScroll ToRight:=3
Columns("M:P").Select
Range("M2").Activate
Selection.ColumnWidth = 11.71
Range("M3").Select
ActiveCell.FormulaR1C1 = "=RC[-4]+RC[-2]"
Range("N3").Select
ActiveCell.FormulaR1C1 = "=RC[-4]+RC[-2]"
Range("O3").Select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Range("P3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+RC[-2]"
Range("A3:P3").Select
Range("P3").Activate
Selection.AutoFill Destination:=Range("A3:P96"), Type:=xlFillDefault
Range("A3:P96").Select

ActiveWindow.SmallScroll Down:=-15
Rows("77:96").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-90
Columns("C:C").Select
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").Select
Selection.NumberFormat = "h:mm;@"
Columns("G:G").Select
Selection.NumberFormat = "h:mm;@"
Range("G8").Select

ActiveWindow.SmallScroll Down:=-21
End Sub

protecting the project is clear (tx)
how would Matt's code be put so as to password protect clicking the command buttons

tpoynton
01-09-2006, 07:56 AM
i have attached a sample; this would be more straightforward if you attached a workbook with sample data and your macro.

this uses Matt's code so that when the user clicks the commandbutton they are prompted for a password; when entered, it runs the rest of your code. the password is currently "mypassword", which you can replace with one of your choosing. having the project locked for viewing will make it more difficult, but not impossible, for people to get the password...copying and pasting the code in the attached sheet1 into your code should do the trick as long as your button is name "commandbutton1". you can bring up the properties for the commandbutton by right-clicking on it in the design mode and selecting Properties (view | toolbars | control toolbox, then click on the design mode button). the (Name) should be CommandButton1 in this example.

I get that you want the button disabled until the password is entered; without seeing your sheet, i just dont know where you are looking for someone to enter the password to enable the button! This will prompt for a password when the button is clicked, which accomplishes the goal of not running the procedure without the password, but I do get that it isnt precisely the behavior your are looking for.

Therefore, if this still doesnt work for some reason, PLEASE post the excel file you are working with! You can add attachments to your post by clicking on "go advanced" then "manage attachments" in the advanced view.

almouchie
01-12-2006, 03:10 AM
thanks for all ur replies_ mvidas,tpoynton,kpuls
it is much appreciated

I used the sample u provided me & worked on it to get to what I want
worked out just fine
thanks again :)