Reputation: 1260
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
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
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
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