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

**jbumps** · 05-15-2013, 01:10 PM

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]

**tehneXus** · 05-15-2013, 01:51 PM

You can pause code using a UserForm, when this UserForm has property "ShowModal" = False you even can edit the sheet while the form is open. When the user closes the form the code will continue.

Example: Pause.xlsm
Code looks like this now, I had to add the "End if" at the end to compile it..:

Sub Test()

    Application.ScreenUpdating = False

    Dim Filename As String
    Dim x As Date, 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
    
        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.ScreenUpdating = True
        
        'pause
        UserForm1.Show
        'resume
        Application.ScreenUpdating = False
        
        'code
        
        
        
        
        
        'end
        Application.ScreenUpdating = True

    End If

End Sub

**Zeos6** · 05-15-2013, 01:59 PM

I just recently had a similar type of issue. In the end I broke up my code into two separate Sub() and it works as intended. I thought about the user form approach and even tried it but I found it too clunky and artificial for what I needed in terms of user experience. My suggestion would be to se if you can break up your code into a "setup" code and then a "processing" code. I hope this helps.