Posts by gmccreedy

Sub SaveIt()
     
    Dim strFirst As String, strLast As String
     
    ChDir "C:\Documents and Settings\All Users\Desktop\TNT Desktop Locker\"
'*****************
    Application.DisplayAlerts = False 
'*****************
    With Worksheets(1)
        strFirst = .Range("C4")
        strLast = .Range("C6")
    End With
     
    ThisWorkbook.SaveAs _
    "C:\Documents and Settings\All Users\Desktop\TNT Desktop Locker\" & _
    strFirst & " -TNT- " & strLast, xlWorkbookNormal
'*****************
    Application.DisplayAlerts = True
'*****************
End Sub

Option Explicit


Sub YesRegenUD()
     ' after user has hit Yes on the RegenerateRequest macro, this posts the new request to
     ' the log, generates the new file and attaches it to an email
     
    Application.Run "LogUnprotect"
'***************************************
    Application.Run "RegenFormUnprotect"  ' moved this to top
'***************************************
    Range(Range("A" & ActiveCell.Row), Range("K" & ActiveCell.Row)).Copy Sheets("Regenerate Request").Range("A40")
'
     ' This sets all of the formulas in the Regenerated Sheet
With Sheets("Regenerate Request")
    Range("C12").Formula = "=D40"
    Range("C14").Formula = "=E40"
    Range("C16").Formula = "=F40"
    Range("C18").Formula = "=G40"
    Range("C20").Formula = "=K40"
    Range("C22").Formula = "=H40"
    Range("C24").Formula = "=J40"
    Range("G5").Formula = "=G10+.01"
    Range("G10").Formula = "=A40"
    Range("G12").Formula = "=B40"
    Range("G14").Formula = "=C40"
    Range("G18").Formula = "=I40"
     ' this copies the new request # and date into A40 and B40
    Range("G5").Copy
    Range("A40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
'
    Range("G7").Copy
    Range("B40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Rows("40:40").Copy
End With
     ' this selects row 40 from the Regen pg and inserts the info into the log as a new
     ' row then sorts the log by Request #
With Sheets("Request Log").Rows("10:10")
    .Insert Shift:=xlDown
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
    Application.Run "SortLogByRequestNumber"
     
     ' This copies the Regen Request Form into another file
    Sheets("Regenerate Request").Cells.Copy
    Workbooks.Add
    ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
'***************************************
' Not Sure why you are pasting twice...
'***************************************
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'    :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C10,C12,C14,C16,C18,C20,C22,C24,G5,G7,G10,G12,G14,G18").Locked = True
    
    Dim strFileName As String
     
    strFileName = ActiveSheet.Range("G1").Value
     
    strFileName = Application.GetSaveAsFilename(strFileName, "Microsoft Excel Workbook (*.xls),*.xls")
     
    ChDir "P:\DesignSheets\CostRequestLog\"
    ActiveWorkbook.SaveAs strFileName
     
    Application.Run "SendCostRequestEmail"
     
    ActiveWorkbook.Close savechanges:=False
     
     'This goes back to the main file and returns to the Request Log
     
    Workbooks("10-3 D05 Cost Request Book.xls").Activate
    Application.Run "RegenFormProtect"
    Sheets("Request Log").Select
     
End Sub

Option Explicit


Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim Cell As Range
Dim rngdata As Range
'
If MsgBox("You are about to Run and Update on all Timesheets, Do you want to proceed?", _
        vbYesNo, "Timesheet Update Manager") = vbYes Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    On Error Resume Next
'----------------------------------------------------------------------------------------------
'
    Set wbCodeBook = ThisWorkbook
'
    With Application.FileSearch
        .NewSearch
         'Change path to suit
        Set rngdata = Sheets("FileCheck").Range("H2")  'This cell provides path for files to update
    For Each Cell In rngdata
        .LookIn = Cell.Value
        .FileType = msoFileTypeExcelWorkbooks
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'  Update code execution area for all Employee Timesheets
'
'**********Enter Update Information Here*********
'
Dim ws As Worksheets
'
For Each ws In ActiveWorkbook.Sheets
    ws.Unprotect Password:="light"
        Range("D7:AH87").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="24"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Invalid Entry"
        .InputMessage = ""
        .ErrorMessage = "Numerical value only.  No Text may be entered."
        .ShowInput = True
        .ShowError = True
    End With
    ws.Protect Password:="light"
Next ws
'
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'
                 wbResults.Close SaveChanges:=True
                 Next lCount
            End If
    Next Cell
    End With
    On Error GoTo 0
'
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    MsgBox "Update Complete"
Else
MsgBox "Update NOT Executed!!"
End If
End Sub