emihir0
emihir0

Reputation: 1260

Excel macro to pause and resume, or remember where stopped

I have made a macro in Excel which will basically outsource all the data from 1 worksheet and separate them into where they belong. Sometimes, however, there is a wrong value which needs to be manually corrected (if done by hand, it would be found straight away during the process of redirecting the data to their separate sheets).

When such a value is found, the cell next to it is marked (to identicate that it is wrong), a warning pops up for the user, but I would also like for the code to "pause", let the user change the values manually and then resume when ready and this is the part I'm not sure how to do (pause & resume).

The whole code for the operation is below (there is another macro which prepares those sheets, but that is not important for now).

Private Sub Zaradi_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngPlan As Range
    Dim pvtTable As PivotTable
    Dim pvtField As PivotField
    Dim pvtItem As PivotItem
    Dim i As Integer
    Dim vykon As Long
    Dim praca As String
    Dim meno As String
    Dim er As String
    Dim errArray(1 To 20) As String
    Dim mbResult As Integer
    Dim parySpolu As Integer

    Set wb = Workbooks("Zoznam plánov")

    er = "Nesedia páry!"

    mbResult = MsgBox("Tieto zmeny sú nezvratné. Potvrdte, že túto operáciu si prajete vykona?", _
    vbYesNoCancel)

    Select Case mbResult

        Case vbYes

            Workbooks("Kontrola plánov").Sheets("Summary").Activate

            meno = Workbooks("Kontrola plánov").Sheets("summary").Cells(2, 9)

            ' zoznam kontrolovanych planov
            Set rngPlan = Workbooks("Kontrola plánov").Sheets("Summary").Range(Cells(2, 1), Cells(10000, 1).End(xlUp))

            For i = 1 To rngPlan.Rows.Count ' pocet riadkov (size) kontrolovanych planov

                ' hodnota vykonu
                vykon = Workbooks("Kontrola plánov").Sheets("summary").Cells(i + 1, 6)
                ' co robil prace
                praca = Workbooks("Kontrola plánov").Sheets("summary").Cells(i + 1, 4)

                ' aktivuje pouzivany plan
                Set ws = wb.Sheets("Plán " & rngPlan(i))

                ws.Activate

                ' prida pracu
                ws.Cells(10000, 1).End(xlUp).Offset(1) = praca

                ' prida vykon
                ws.Cells(10000, 2).End(xlUp).Offset(1) = vykon

                ' prida meno
                ws.Cells(10000, 3).End(xlUp).Offset(1) = meno

                Set pvtTable = ws.PivotTables(1)
                Set pvtField = pvtTable.PivotFields(1)

                pvtTable.PivotCache.Refresh

                For j = 1 To pvtField.PivotItems().Count         

                    Set pvtItem = pvtField.PivotItems(j)                                    
                    pvtItem.ShowDetail = False                                        
                    ActiveSheet.PivotTables(1).NullString = "0"                                    
                    If pvtItem.Value = "(blank)" Then

                    Else
                        parySpolu = pvtTable.GetPivotData("Páry", "Práca", pvtField.PivotItems(j))
                        If parySpolu > ws.Cells(2, 7) Then
                            ws.Cells(j + 1, 11) = er
                            pvtItem.ShowDetail = True
                            MsgBox er
                        Else
                            ws.Cells(j + 1, 11) = "OK"
                        End If                             
                    End If
                Next j       
            Next i

            ' aktivuje sumarizaciu
            Workbooks("Kontrola plánov").Sheets("summary").Activate

        Case vbNo
            Exit Sub
        Case vbCancel
            Exit Sub
    End Select

    Workbooks("Kontrola plánov").Sheets(1).Activate
    MsgBox errNumbers

End Sub

The part of code where the wrong value is found and a warning is given is here:

If parySpolu > ws.Cells(2, 7) Then
    ws.Cells(j + 1, 11) = er
    pvtItem.ShowDetail = True
    MsgBox er
Else
    ws.Cells(j + 1, 11) = "OK"
End If

I already had suggestions on how to do this. One was using an InputBox, but I think that is not ideal for this situation (as the user would prefer to check everything properly, source sheet, find the source of problem etc) and so pausing & resuming would be better I think. Another suggestion was to do something like:

Public lastCellChecked As String

Sub Check_Someting()

    Dim cell As     Excel.Range
    Dim WS As       Excel.Worksheet

    If Not lastCellChecked = vbNullString Then Set cell = Evaluate(lastCellChecked)

    '// Rest of code...

    '// Some loop here I'm assuming...
    lastCellChecked = "'" & WS.Name & "'!" & cell.Address
    If cell.Value > 10 Then Exit Sub '// Lets assume this is classed as an error
    '// Rest of loop here...

    lastCellChecked = vbNullString
End Sub

Where the address of last cell before error is stored and macro continues from there onwards upon next run (if nothing is stored, it runs from beginning). I think this solution is more suitable for my problem. However, in the end, I'm a very unexperienced "programmer"and so would like to know what is the most efficient/best way for this (and any other improvements for my already implemented code would be greatly appreciated).

Upvotes: 0

Views: 5181

Answers (3)

user3819867
user3819867

Reputation: 1118

Use a global variable, e.g. ProcessPaused As Boolean and:

ProcessPaused = True
Do While ProcessPaused
    DoEvents
Loop

Once you're done correcting the value a

Sub corrected()
    ProcessPaused = False
End Sub

will enable your macro to continue.

Implemented to your case it will look like:

If parySpolu > ws.Cells(2, 7) Then
    ws.Cells(j + 1, 11) = er
    pvtItem.ShowDetail = True
    MsgBox er
    ProcessPaused = True
    Do While ProcessPaused
        DoEvents
    Loop
Else
    ws.Cells(j + 1, 11) = "OK"
End If

And of course you'll have to place a huge button:

Sub PokracovatVProcese_Click()
    ProcessPaused = False
End Sub

Upvotes: 0

Wiktor Stribiżew
Wiktor Stribiżew

Reputation: 627609

I see no point in stopping/resuming macro to allow human intervention just because macros are meant to automate things. If a human needs to intervene, (s)he might as well re-run the macro to let it check the entire range needed.

If you have performance issues (say, because you have heaps of data inside), you might need to optimize the code.

So, I'd rather you stop macro execution upon error with a message(!) warning user of unwelcome data, or - better - make sure the error is checked before the problem occurs.

Upvotes: 0

Ralph
Ralph

Reputation: 9444

Excel is event driven. No event = no action. So, basically, the question is what the event should be that triggers the "continuation" of your code.

The first option is (as you pointed out) that you use an input box or form and once the correction has been entered the code continues. In this case there is the event "click on a button" to confirm corrective value.

If you want to allow a user to make the change on the sheet itself then there is no other event to use but to catch "Worksheet_Change" event. So, basically if there is an error that needs correction you will have to halt / stop the code (and save on some hidden sheet which cell needs correction). Afterwards you can use the

Private Sub Worksheet_Change(ByVal Target As Range)

'Assuming that you "saved" the last position here:
'SomeHiddenSheet.Range("A1").value2 = "$D$10"  <-- this is the location where an error occurred which needed fixing

If Intersect(Target, SomeHiddenSheet.Range("A1").Value2) Is Nothing Then
    'The user did not change the requested cell but another
Else
    'The user change the cell
End If

End Sub

event to check if the cell you requested has been changed. But with this solution you have the problem that your code stopped. The user may change the cell you asked him/her to change. But there is no guarantee. In fact the user may decide to change another cell or not do anything at all and just save / close the file. So, with this solution you will probably have the re-check all prior cells again.

Upvotes: 0

Related Questions