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").ActivateLastRow = 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 AActiveWorkbook.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 WithSheets("Archive").Activate
Range("A1").SelectEnd Sub
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
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?
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..
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
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 saveIts a lot ,is it possible??? but thanks ahead of time man
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!!
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,
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
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 IfIf 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 IfYou can add an "ElseIf" for each input cell.
Give these a try and see how they work for you.
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!!
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
Okay thats it i placed it right before the clear contents. Thanks AGAIN!! Works Great now!!
