Attribute VB_Name = "Quick_Update" 'Terms and Conditions: ' '1. GRANT OF LICENSE. Steven J. Peterson, MBA, PE (Grantor) 'grants to you the non-exclusive right to use, to reproduce and 'distribute the Quick Update macro (Macro) provided: a) The 'Macro is not distributed for profit or distributed in 'conjunction with for profit software, b) The Macro is not 'rented, leased, or subleased, and c) these Terms and Conditions 'must accompany all copies of the Macro. ' '2. COPYRIGHT. The Macro constitutes intellectual property of 'and is owned by Steven J. Peterson, MBA, PE, and is protected 'by United States copyright laws and international treaties 'provisions. You may not remove the copy notice from any copy of 'the Macro. This agreement does not grant you any intellectual 'property rights in the Macro. ' '3. DISCLAIMER OF WARRANTY. THE MACRO IS UNDOCUMENTED 'MACROCODE AND IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. 'STEVEN J. PETERSON, MBA, PE FURTHER DISCLAIMS ALL OTHER WRITTEN 'OR IMPLIED WARRANTIES, INCLUDING BUT NOT LIMITED TO: ANY 'IMPLIED WARRANTIES OF MERCHANTABILITY, SATISFACTORY QUALITY, OR 'OF FITNESS FOR A PARTICULAR USE OR PURPOSE. THE ENTIRE RISK 'ARISING OUT OF THE USE OR PERFORMANCE OF THIS MACRO REMAINS 'WITH THE USER. ' 'IN NO EVENT SHALL STEVEN J. PETERSON, MBA, PE, BE LIABLE FOR 'ANY DAMAGES, INCLUDING BUT NOT LIMITED TO: DAMAGES FOR LOSS OF 'BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS 'INFORMATION, OR OTHER PECUNIARY LOSS; ARISING OUT OF THE USE OF 'OR INABILITY TO USE THIS MACRO, EVEN IF STEVEN J. PETERSON, MBA, 'PE, HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 'BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSIONS OR LIMITATIONS 'OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE 'LIMITATIONS MAY NOT APPLY TO YOU. ' 'GRANTOR'S AGGREGATE LIABILITY UNDER OR IN CONJUNCTION WITH THIS 'AGREEMENT SHALL BE LIMITED TO THE AMOUNT PAID FOR THE SOFTWARE, 'IF ANY. Nothing contained in this Agreement limits Grantor's 'liability to you in the event of death or personal injury 'resulting from Grantor's negligence or for the tort of deceit '(fraud). ' '4. GOVERNING LAW. This Agreement is governed by the laws of 'the State of Utah. ' '5. ACCEPTANCE. By installing, using, accessing, downloading, 'copying or otherwise benefiting from using the functionality of 'all or any portion of The Macro, the user agrees to be bound by 'these Terms and Conditions. These Terms and Conditions are 'enforceable like any written agreement. Sub Quick_Update() Attribute Quick_Update.VB_Description = "Macro update\nMacro Recorded 1/27/01 by Steven Peterson." ' Macro Quick Update ' Macro Written 1/27/01 by Steven Peterson. ' Last Updated 5-23-01: Added check for Project Status Date With ActiveProject ' Check for Project Status Date If ActiveProject.StatusDate <> "NA" Then GoTo Line10 Else A = MsgBox("Project Status Date must be set before using this macro. Macro will be terminated!", vbCritical, "Error") GoTo Line400 End If ' Set up variables to be used with cancel button. Line10: TempDuration = ActiveCell.Task.Duration TempPercentComplete = ActiveCell.Task.PercentComplete ' Move the finish date and percent complete to the status date. Line25: If ActiveCell.Task.Finish < .StatusDate Then ActiveCell.Task.Duration = ActiveCell.Task.Duration + .HoursPerDay * 60 GoTo Line25 Else SelectRow row:=0 UpdateProject All:=False, UpdateDate:=.StatusDate, Action:=1 Defaulttext = ActiveCell.Task.RemainingDuration / (.HoursPerDay * 60) NewRemdur = InputBox("Enter Remaining Duration to the task: ", "Quick Update", Defaulttext) Line100: ' Check for cancel button. If NewRemdur = "" Then GoTo Line300 'Check for a percentage. If Right(NewRemdur, 1) = "%" Then GoTo Line175 ' Check to see if it is a number. If IsNumeric(NewRemdur) = False Then GoTo Line150 ' Check for positive number. If NewRemdur >= "0" Then GoTo Line200 Line150: ' Ask for a positive number. NewRemdur = InputBox("Remaining Duration must be a positive number: ") GoTo Line100 Line175: ' Calculate the remaining duration based upon the percentage. ' IF 100 percent or greater then set remaning duration to 0 If Mid(NewRemdur, 3, 1) = "%" Then NewRemdur = Left(NewRemdur, 2) Else NewRemdur = 0 GoTo Line200 End If ' Calculate remaining duration and round to a whole number greater than 0 actdur = (ActiveCell.Task.ActualDuration / (.HoursPerDay * 60)) NewRemdur = actdur * ((100 - NewRemdur) / NewRemdur) NewRemdur = Round(NewRemdur, 0) If NewRemdur = 0 Then NewRemdur = 1 Line200: ' Update duration and percent complete. I don't know why both of these statements are ' needed, but without both of them the progress line may be crooked. SetTaskField field:="Remaining Duration", Value:=NewRemdur + 1 SetTaskField field:="Remaining Duration", Value:=NewRemdur SelectRow row:=1 GoTo Line400 ' Cancle button entred. Reset data. Line300: ActiveCell.Task.Duration = TempDuration ActiveCell.Task.PercentComplete = "0" ActiveCell.Task.PercentComplete = TempPercentComplete Line400: End If End With End Sub