Lock a cell value and only refresh upon a key stroke

[muhleebbin]

Hi,

Could someone help me with a piece of code where it locks a value that's on another worksheet and would only update the value on that worksheet upon a key stroke?

I'm trying to build a password generator for our company software but it's currently copying a new password for every instance rather than just keeping the same password that's in the first cell. Examples below:

Password Generator v2.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2		Series	Type	Characters	Random Number	Index	Characters
3		1st	Random Number	7	1.0003	8	-		Password	-j7J.yJ9
4			Random Uppercase Letter	J	5.0004	3	j
5			Random Lowercase Letter	j	8.0005	1	7		Click F9 to regenarate
6			Random Symbol	.	7.0006	2	J
7		2nd	Random Number	9	3.0007	4	.
8			Random Uppercase Letter	J	1.0008	7	y
9			Random Lowercase Letter	y	2.0009	6	J
10			Random Symbol	-	2.001	5	9
11
PW Generator

Cell Formulas
Range	Formula
D3,D7	D3	=RANDBETWEEN(0,9)
E3:E10	E3	=RANDBETWEEN(1,8)+ROW()/10000
F3:F10	F3	=RANK(E3,$E$3:$E$10)
G3:G10	G3	=INDEX($D$3:$D$10,F3)
D4,D8	D4	=CHAR(RANDBETWEEN(65,90))
D5,D9	D5	=CHAR(RANDBETWEEN(97,122))
D6,D10	D6	=CHAR(RANDBETWEEN(33,47))
J3	J3	=CONCATENATE(G3,G4,G5,G6,G7,G8,G9,G10)

Password Generator v2.xlsm
	D	E	F	G
3	Location:	Location3
4	Position:	Test3
5	Detailed Position:	Test 3.1
6	Name:	John Doe
7	Email:	jdoe@email.com
8
9	Program
10	Program1	jdoe	Zz1uZ&2)
11	Program3	jdoe	q+D)n5Z9
12	Program4	Email Setup
13	Program6	jdoe@e.com	n1d2L//K
14	Program7	johndoe	UlL9-.p8	Company
Input

Cells with Data Validation
Cell	Allow	Criteria
E3	List	=Lists!$M$2:$M$12
E4	List	=Validation_List
E5	List	=INDIRECT(SUBSTITUTE(E4," ",""))

I have code that is supposed to copy the values in all the cells but when it copies it refreshes the password generator each time so a new password is created for each program. Code is:

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    'cells to copy from Input sheet - some contain formulas
    myCopy = "E3,E4,E5,E6,E7,D10:G40"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("Data")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With

'formula fill ins
End Sub

 

[sxhall]

Hi muhleebbin

​

I think, from reading the above, you just want the password that is generated in cell J3 when F9 is pressed to not change and be the same against all programs, is that correct?

In which case I've just added in some more code to add in the formulas in range D3:G10 and then copy them as values to the cells. The rest of your code then runs, this will mean the password won't change whilst the code is running whenever the sheet/workbook recalculates.

Alternatively you could store the password in cell J3 as string and then copy this against each program in F10:F14. Only aside with this is that the formulas range D3:G10 would still recalculate whenever a change is made to the workbook while the code is running or when a user makes a change.

As for the keystroke to run the code I'd just add a button to the worksheet to trigger the code instead.

Please note I have not fully tested the code, only the additional part I have added in.

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    '***Start additional code
    
        With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    With Worksheets("historyWks") '*** change sheet name here if this is not the correct sheet name ***
    
        .Range("D3").FormulaR1C1 = "=RANDBETWEEN(0,9)"
        .Range("D4").FormulaR1C1 = "=CHAR(RANDBETWEEN(65,90))"
        .Range("D5").FormulaR1C1 = "=CHAR(RANDBETWEEN(97,122))"
        .Range("D6").FormulaR1C1 = "=CHAR(RANDBETWEEN(33,47))"
        .Range("D7").FormulaR1C1 = "=RANDBETWEEN(0,9)"
        .Range("D8").FormulaR1C1 = "=CHAR(RANDBETWEEN(65,90))"
        .Range("D9").FormulaR1C1 = "=CHAR(RANDBETWEEN(97,122))"
        .Range("D10").FormulaR1C1 = "=CHAR(RANDBETWEEN(33,47))"
        .Range("E3:E10").FormulaR1C1 = "=RANDBETWEEN(1,8)+ROW()/10000"
        .Range("F3:F10").FormulaR1C1 = "=RANK(RC[-1],R3C5:R10C5)"
        .Range("G3:G10").Formula2R1C1 = "=INDEX(R3C4:R10C4,RC[-1])"
        .Range("J3").FormulaR1C1 = "=CONCATENATE(RC[-3],R[1]C[-3],R[2]C[-3],R[3]C[-3],R[4]C[-3],R[5]C[-3],R[6]C[-3],R[7]C[-3])"
  
        With .Range("D3:G10")
             .Copy
             .PasteSpecial Paste:=xlPasteValues
        End With
    
    End With
    
    With Application
      .Calculation = xlAutomatic
      .CutCopyMode = False
      .ScreenUpdating = True
    End With
    
    '***End additional code
    
    'cells to copy from Input sheet - some contain formulas
    myCopy = "E3,E4,E5,E6,E7,D10:G40"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("Data")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With

'formula fill ins
End Sub

Hope this helps!

 

[muhleebbin]

Hi sxhall,

Thank you very much for the suggestions! I actually like the idea of saving the password as a string and then filling it in. I don't necessarily care if it refreshes in the background as long as the paste value is the same.

One thing about the Input sheet that I was hoping you could help further with is: the formula in cells F10:F40 is filled with a conditional.

=IF(OR(D10="",E10="Email Setup"),"",'PW Generator'!$J$3)

Depending on the position the number of programs that person has access to could vary from anywhere from 3 programs to about 15. So the paste range varies dependent on the position. Also, as the formula implies, if the program has an email setup then it wouldn't need the password pasted since the user will create their own password. Could you help make the paste conditional like the above formula?

Thank you again for your assistance here!!