Results 1 to 3 of 3

Pausing A Macro (allow user to extract data) aAnd Resume Macro

Threaded View

  1. #1
    Registered User
    Join Date
    12-13-2012
    Location
    Morgantown
    MS-Off Ver
    Excel 2003
    Posts
    3

    Pausing A Macro (allow user to extract data) aAnd Resume Macro

    All,

    I have a Macro that I would like to pause, so the user may copy information in a calculated table, and then have the Macro resume. The reasono for the pause is that the information that needs to be copied and extracted will be overwritten one day a week (Monday's when data for Friday, Saturday and Sunday are calculated). I apologize for the length of code supplied, I've attemped to edit it down but keep enough that members will be able to follow it. To highlight the areas where I'd like to pause the Macro, I've currently input an "application.wait Now" function and changed that portion of the code to red text.

    Thanks to anyone who can offer some insight.



    [CODE] Dim Filename As String
    Dim x, y As Date
    x = Now()
    y = x - 1

    Dim DateValue1 As String
    DateValue1 = Format(Date - 1, "mm/dd/yyyy")

    Dim DateValue2 As String
    DateValue2 = Format(Date - 2, "mm/dd/yyyy")

    Dim DateValue3 As String
    DateValue3 = Format(Date - 3, "mm/dd/yyyy")


    Filename = "Daily Dose Count_By Department and Material_" & Format(y, "mmddyyyy") & ".xls"
    Windows(Filename).Activate
    ActiveSheet.Paste
    Calculate

    If Weekday(Date) = 4 Then

    Sheets("Daily Dose Output by Material").Select
    Range("a2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("c2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

    Sheets("Data Drop").Select
    Range("a1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter

    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$M$2888").AutoFilter Field:=13, Criteria1:="DS"
    ActiveSheet.Range("$A$1:$M$2888").AutoFilter Field:=3, Criteria1:= _
    "=GR for order", Operator:=xlOr, Criteria2:="=GR for order rev."
    ActiveSheet.Range("$A$1:$M$2888").AutoFilter Field:=10, Operator:= _
    xlFilterValues, Criteria2:=Array(2, DateValue3)

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Daily Dose Output by Material").Select
    Range("A2").Select
    ActiveSheet.Paste
    Calculate

    ActiveWindow.SmallScroll Down:=0
    Sheets("Data Drop").Select
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Daily Dose Output by Material").Select
    Range("C2").Select
    ActiveSheet.Paste
    Calculate
    Sheets("Total Daily Dose Output by Dept").Select
    Range("D5").Select
    Selection.Copy
    Sheets("Daily and MTD").Select
    Range("B3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True

    ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("Daily and MTD").Select
    Range("C3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell = Application.WorksheetFunction.Sum(Range("B3:B33"))
    Calculate

    Sheets("Total Daily Dose Output by Dept").Select
    Range("B10").Select
    Selection.Copy

    Sheets("Daily and MTD").Select
    Range("E3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("Total Daily Dose Output by Dept").Select
    Range("B11").Select
    Selection.Copy

    Sheets("Daily and MTD").Select
    Range("G3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("Total Daily Dose Output by Dept").Select
    Range("B12").Select
    Selection.Copy

    Sheets("Daily and MTD").Select
    Range("I3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


    Application.Wait Now + TimeValue("00:00:15") [CODE]
    Last edited by jbumps; 05-15-2013 at 01:12 PM. Reason: Forgot to add [Code] Tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1