Articles

Solved Lock cells after data is entered then save with macro

December 12, 2012 at 13:43:16
Specs: Windows 7

I have a calculator i made that you input data into then it outputs the answer you need for the application. Cells C10,E10,J10,D14,D18 are the input data H27,D27 are the output. I need to copy these inputs and outputs to an archive sheet that will keep records in a certain order. That order is column B,C,D,E,A input, then G,F output respectivley. After it copies to these lines I need the macro to drop to next blank row, then zero the input cell and repeat on the next line everytime the button is press. If this helps any let me no i have it to where it copies to all the column 2nd row and move to next blank row but cant get it to repeat on that row and continue when i press the button.
::"This part is done i will post a sample after"::
What i need now is to lock the cells after the next blank row is filled and continue to lock the next cell after the data is transfered. Then i need to have the macro save each time.

I got some great help last go around (Kudos AlteK, and Derbydad03) looking forward to your responses. let me know if you need furthur info

thanks


Here what I got now ( With help of others, it works great I dont want to change this just add whats above....)


Sub Archive2()

Application.ScreenUpdating = False


'Calculator Archive Col
'C10 B
'E10 C
'J10 D
'D14 E
'D18 A
'H27 G
'D27 F


Sheets("Calculator").Activate

LastRow = Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Row + 1 'Sets the last row in the Archives

'Copies the Calculator data to the Archive
Sheets("Archive").Range("B" & LastRow) = Range("C10")
Sheets("Archive").Range("C" & LastRow) = Range("E10")
Sheets("Archive").Range("D" & LastRow) = Range("J10")
Sheets("Archive").Range("E" & LastRow) = Range("D14")
Sheets("Archive").Range("A" & LastRow) = Range("D18")
Sheets("Archive").Range("G" & LastRow) = Range("H27")
Sheets("Archive").Range("F" & LastRow) = Range("D27")

'Date and time of the archiving
Sheets("Archive").Range("H" & LastRow) = Now

'Clears out the input data in the calculator but does not touch the calculated cells in the calculator


Range("C10,E10,J10,D14,D18").ClearContents

'Sort on Column A

ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Archive").Sort
.SetRange Range("A1:H" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("Archive").Activate
Range("A1").Select

End Sub


See More: Lock cells after data is entered then save with macro

Report •


✔ Best Answer
January 7, 2013 at 09:53:06

The code will stop the macro from continuing so long as it is placed at the top of the macro.

Here is my version. Can you post your macro if it is substantially different so that I can try to spot the problem

Sub Archive()

Application.ScreenUpdating = False




'Calculator   Archive Col
'C10            C
'E10            B
'J10            D
'D14            E
'D18            A
'H27            F
'D27            G

'A1             H               Name
    

'VALIDATION code
If Range("A1") = "" Then
    Resp1 = MsgBox("You have not entered your name in _'A1'. Please do so after clicking on 'OK' and then re-run the routine", vbOKOnly)
    End
ElseIf Range("C10") = "" Then
    Resp1 = MsgBox("C10 --- put in the message you want here", vbOKOnly)
    End
End If
    
    
    Sheets("Archive").Unprotect

Sheets("Calculator").Activate

LastRow = Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Row + 1 'Sets the last row in the Archives

'Copies the Calculator data to the Archive
        Sheets("Archive").Range("A" & LastRow) = Range("D18")
        Sheets("Archive").Range("B" & LastRow) = Range("E10")
        Sheets("Archive").Range("C" & LastRow) = Range("C10")
        Sheets("Archive").Range("D" & LastRow) = Range("J10")
        Sheets("Archive").Range("E" & LastRow) = Range("D14")
        Sheets("Archive").Range("F" & LastRow) = Range("H27")
        Sheets("Archive").Range("G" & LastRow) = Range("D27")
 
        Sheets("Archive").Range("H" & LastRow) = Range("A1")

 
 
'Date and time of the archiving
        Sheets("Archive").Range("H" & LastRow) = Now
        

'Clears out the input data in the calculator but does not touch the calculated cells in the calculator
        
 
        Range("C10,E10,J10,D14,D18").ClearContents
   
'Sort on Column A

    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Archive").Sort
        .SetRange Range("A1:H" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Sheets("Archive").Select
Sheets("Archive").Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
Application.ThisWorkbook.Save
End Sub



#1
December 12, 2012 at 15:06:44

Hi BJELLS

To save the workbook after the data is archived you can add this to the end of the macro;

Application.ThisWorkbook.Save

I don't understand why you want to "lock cells". Can you explain why you need this?


Report •

#2
December 12, 2012 at 19:42:42

Yes i can explain. A lot of people are going to be handling the calculator. When the information gets sent to archive sheet its open to be accidently changed and when that reciepe goes to be used again it could be wrong and mess up what there doing. So i want to lock the Archive cell by cell. I tried to just protect the whole sheet but then the data would not transfer to the archive sheet after the "reset button". So when the data gets entered into the next blank row i was to protect that row and all the rows with data in it but not the blank ones left over so hopefully the macro will continue to transfer data. Does this explain a little further?? Please let me know..

Report •

#3
December 12, 2012 at 20:30:27

What if you just hide the Archive sheet? Would that be enough?

Report •

Related Solutions

#4
December 12, 2012 at 20:48:55

Here's the macro that will protect and un-protect the archive sheet - so long as
there is no password set for the lock. It will also hide the archive sheet.

Have a play and see if it will suit your needs.

Sub Archive()

Application.ScreenUpdating = False


'Calculator   Archive Col
'C10            C
'E10            B
'J10            D
'D14            E
'D18            A
'H27            F
'D27            G

Sheets("Archive").Unprotect

Sheets("Calculator").Activate

LastRow = Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Row + 1 'Sets the last row in the Archives

'Copies the Calculator data to the Archive
        Sheets("Archive").Range("C" & LastRow) = Range("C10")
        Sheets("Archive").Range("B" & LastRow) = Range("E10")
        Sheets("Archive").Range("D" & LastRow) = Range("J10")
        Sheets("Archive").Range("E" & LastRow) = Range("D14")
        Sheets("Archive").Range("A" & LastRow) = Range("D18")
        Sheets("Archive").Range("F" & LastRow) = Range("H27")
        Sheets("Archive").Range("G" & LastRow) = Range("D27")
 
'Date and time of the archiving
        Sheets("Archive").Range("H" & LastRow) = Now
        

'Clears out the input data in the calculator but does not touch the calculated cells in the calculator
        
 
        Range("C10,E10,J10,D14,D18").ClearContents
   
'Sort on Column A

    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Archive").Sort
        .SetRange Range("A1:H" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Sheets("Archive").Visible = False

Sheets("Archive").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ThisWorkbook.Save
End Sub


Report •

#5
December 13, 2012 at 04:58:53

AlteK,
I tried this macro and i dont want to hide the archive sheet because eventually this will be used as a shortchut if the recicepe has been entered before they can Ctrl + F and locate that. I would like it to protect kind of like how it moves to next row when copying calculator, except it need to copy to the next blank row then lock that row and move down. Or copy the to the next blank row move down and lock the row above itself. If this is possible...??? I guess it needs to copy to the calculator do the autofilter, then that row needs to format itself to be locked,then protect the workbook so the data in the archive sheet cant be changed, then finally save

Its a lot ,is it possible??? but thanks ahead of time man


Report •

#6
December 13, 2012 at 06:17:20

Okay AlteK,

I does work i took out the hide and formatted the cells to let ppl insert rows and autofilter..

Thanks a lot again!!


Report •

#7
December 13, 2012 at 10:40:49

Hi BJELLS

That's great. It sounds like you are taking over the enhancement of the macro. Some other enhancements you may want to consider are;


1. capturing the user's name in the calculator sheet
2. storing the user name in the archive sheet
3. if the user does not enter their name or, for that matter, if any calculator field 
   is not entered, suspending the macro and popping up a message to the user that
   whichever field has not been entered is compulsory.

We'll be happy to help with whatever enhancements you come up with,


Report •

#8
January 2, 2013 at 09:32:44

AlteK,
Sorry for the delayed response I am just now seeing this post I think all three of those enhancements would be absolutely great and work right in step to what I am doing! Do you have an Idea to where i would start

Report •

#9
January 2, 2013 at 12:42:19

No worries - hope you had a great holiday season.

Adding the person's name can be easy enough just by adding a cell in the calculator for that purpose. Let's say you choose A1 for the person's name then you would add this to the VBA

Sheets("Archive").Range("H" & LastRow) = Range("A1")

To ensure that there is something input in that cell you can add this to the VBA

If Range("A1") = "" Then
    Resp1 = MsgBox("You have not entered your name in 'A1'. Please do so after clicking on 'OK' and then re-run the routine", vbOKOnly)
    End
End If

If you want to ensure that any other of the input cells are filled in you can add "Else If"s to the above

If Range("A1") = "" Then
    Resp1 = MsgBox("You have not entered your name in 'A1'. Please do so after clicking on 'OK' and then re-run the routine", vbOKOnly)
    End
ElseIf Range("C10") = "" Then
    Resp1 = MsgBox("put in the message you want here", vbOKCancel)
    End
End If

You can add an "ElseIf" for each input cell.

Give these a try and see how they work for you.


Report •

#10
January 7, 2013 at 04:49:27

Thanks a lot AlTek this actually work great, but how to do I stop the macro and go back to the top if a field is blank and move forward with the macro if everything is filled. Right now it will send the alert message but will continue to archive the data. Is there a way to stop the macro if the cell is empty and continue if all is filled??

Thanks and my Holiday was great hope yours way to. Always enjoy family!!


Report •

#11
January 7, 2013 at 09:53:06
✔ Best Answer

The code will stop the macro from continuing so long as it is placed at the top of the macro.

Here is my version. Can you post your macro if it is substantially different so that I can try to spot the problem

Sub Archive()

Application.ScreenUpdating = False




'Calculator   Archive Col
'C10            C
'E10            B
'J10            D
'D14            E
'D18            A
'H27            F
'D27            G

'A1             H               Name
    

'VALIDATION code
If Range("A1") = "" Then
    Resp1 = MsgBox("You have not entered your name in _'A1'. Please do so after clicking on 'OK' and then re-run the routine", vbOKOnly)
    End
ElseIf Range("C10") = "" Then
    Resp1 = MsgBox("C10 --- put in the message you want here", vbOKOnly)
    End
End If
    
    
    Sheets("Archive").Unprotect

Sheets("Calculator").Activate

LastRow = Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Row + 1 'Sets the last row in the Archives

'Copies the Calculator data to the Archive
        Sheets("Archive").Range("A" & LastRow) = Range("D18")
        Sheets("Archive").Range("B" & LastRow) = Range("E10")
        Sheets("Archive").Range("C" & LastRow) = Range("C10")
        Sheets("Archive").Range("D" & LastRow) = Range("J10")
        Sheets("Archive").Range("E" & LastRow) = Range("D14")
        Sheets("Archive").Range("F" & LastRow) = Range("H27")
        Sheets("Archive").Range("G" & LastRow) = Range("D27")
 
        Sheets("Archive").Range("H" & LastRow) = Range("A1")

 
 
'Date and time of the archiving
        Sheets("Archive").Range("H" & LastRow) = Now
        

'Clears out the input data in the calculator but does not touch the calculated cells in the calculator
        
 
        Range("C10,E10,J10,D14,D18").ClearContents
   
'Sort on Column A

    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Archive").Sort
        .SetRange Range("A1:H" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Sheets("Archive").Select
Sheets("Archive").Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
Application.ThisWorkbook.Save
End Sub


Report •

#12
January 9, 2013 at 03:20:01

Okay thats it i placed it right before the clear contents. Thanks AGAIN!! Works Great now!!

Report •


Ask Question