MsgBox keeps popping up

hazmat

New Member
Joined
Jun 14, 2019
Messages
19
I have this code that almost works, but has one issue. I think i know why, but dont know how to fix it.
As dates are entered elsewhere, G11 counts them. When G11 = G16, it throws up the MsgBox. So far so good.
When I hit 'OK' on the MsgBox, Step 1 occurs (saves the file), but then the MsgBox reappears. If i hit 'cancel' on the second time the Box pops up, the end result is what i want. (sorts the list by the existing dates, clears the proper cells, and does a 'SaveAs' the new file name)

I don't want the MsgBox to pop up twice.

I think the problem is that since im using 'Worksheet_Change' and when it does the sort, its rearranging the dates before it tries to clear, so G11 is still = to G16 and the sheet changed, therefore the Box pops back up.
Ive tried using 'worksheet_activate' and ApplicationEnableEvents = false, but neither worked.
Its probably something easy, but i just dont have any experience with VBA Code. Im surprised i got this far.

Thanks for any help

Sorry for my ignorance, but i'm just a dumb firefighter, trying to make it easier for other dumb firefighters. This is being done with paper and pencil right now, lol


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    '# of OT's taken (G11) = Max OT's allowed (G16)
    If Range("G11").Value = Range("G16").Value Then
    
    Result = MsgBox("END OF ROUND" & vbNewLine & "Click 'OK' to start new round" & vbNewLine & "Click 'Cancel' to return, to make changes", vbOKCancel + vbCritical, "End of Round")
        If Result = vbOK Then
        
'Step 1
        'Saves workbook before Additional Op OT List sort, as existing filename
        ActiveWorkbook.Save
        
'Step 2
        'Sorts Additional Op List for next round
        Dim Rw As Long, Ac As Long, c As Long, n As Long
                 
        Rw = (Range("E48:E77,H48:H77,K48:K77,N48:N77,Q48:Q77").Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row) - 47
                
        ReDim ray(1 To 30, 1 To 17)
                
            For n = Rw + 1 To 30
                c = c + 1
                For Ac = 2 To 17 Step 3
                    ray(c, Ac) = Cells((n + 47), Ac)
                Next Ac
            Next n
                    
            For n = 1 To Rw
                c = c + 1
                For Ac = 2 To 17 Step 3
                    ray(c, Ac) = Cells((n + 47), Ac)
                Next Ac
            Next n
            
            Range("A48").Resize(30, 17) = ray
                
'Step 3
            'Clears all OT dates
            Range("E8:E37, E48:E77, H48:H77, K48:K77, N48:N77, Q48:Q77").ClearContents
                        
'Step 4
            'Saves next blank round to current directory and names it HazMat FF Round Started - MM-DD-YYYY
            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\HazMat FF Round Started - " & Format(Date, "MM-DD-YYYY")
                        
        End If
    End If
    
End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Could you set G11 back to zero (or something other than the G16 value), BEFORE your code ends, so that when it fires again (due to the worksheet change) it exits immediately?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    '# of OT's taken (G11) = Max OT's allowed (G16)
    If Range("G11").Value = Range("G16").Value Then
    Range("G11").Value = 0
    Result = MsgBox("END OF ROUND" & vbNewLine & "Click 'OK' to start new round" & vbNewLine & "Click 'Cancel' to return, to make changes", vbOKCancel + vbCritical, "End of Round")
        If Result = vbOK Then
        
'Step 1
        'Saves workbook before Additional Op OT List sort, as existing filename
        ActiveWorkbook.Save
        
'Step 2
        'Sorts Additional Op List for next round
        Dim Rw As Long, Ac As Long, c As Long, n As Long
                 
        Rw = (Range("E48:E77,H48:H77,K48:K77,N48:N77,Q48:Q77").Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row) - 47
                
        ReDim ray(1 To 30, 1 To 17)
                
            For n = Rw + 1 To 30
                c = c + 1
                For Ac = 2 To 17 Step 3
                    ray(c, Ac) = Cells((n + 47), Ac)
                Next Ac
            Next n
                    
            For n = 1 To Rw
                c = c + 1
                For Ac = 2 To 17 Step 3
                    ray(c, Ac) = Cells((n + 47), Ac)
                Next Ac
            Next n
            
            Range("A48").Resize(30, 17) = ray
                
'Step 3
            'Clears all OT dates
            Range("E8:E37, E48:E77, H48:H77, K48:K77, N48:N77, Q48:Q77").ClearContents
                        
'Step 4
            'Saves next blank round to current directory and names it HazMat FF Round Started - MM-DD-YYYY
            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\HazMat FF Round Started - " & Format(Date, "MM-DD-YYYY")
                        
        End If
    End If
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,020
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top