Macro niet twee keer starten

[mvw64]

Ik heb een vraag over het starten van een macro
je mag een macro pas starten als de andere macro klaar is
zie voorbeeld

 

[edmoor]

Hier je ervoor aangepaste functie. De rode regels heb ik toegevoegd. Probeer het eens:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
    Cancel = True
[COLOR="#FF0000"]    Static BeforeRightClickIsRunning As Boolean
    
    If BeforeRightClickIsRunning Then Exit Sub
    BeforeRightClickIsRunning = True[/COLOR]

    If Intersect(ActiveCell, Range("C2:H2")) Is Nothing Then Exit Sub

    If ActiveCell.Offset(1, 0) = Empty Then ActiveCell.Offset(1, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(1, 0).ClearContents

    If ActiveCell.Offset(2, 0) = Empty Then ActiveCell.Offset(2, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(2, 0).ClearContents

    If ActiveCell.Offset(3, 0) = Empty Then ActiveCell.Offset(3, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(3, 0).ClearContents

    If ActiveCell.Offset(4, 0) = Empty Then ActiveCell.Offset(4, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(4, 0).ClearContents

    If ActiveCell.Offset(5, 0) = Empty Then ActiveCell.Offset(5, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(5, 0).ClearContents

    If ActiveCell.Offset(6, 0) = Empty Then ActiveCell.Offset(6, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(6, 0).ClearContents

    If ActiveCell.Offset(7, 0) = Empty Then ActiveCell.Offset(7, 0) = 1
    For van = 1 To 20000000: Next: ActiveCell.Offset(7, 0).ClearContents

    ActiveCell.Offset(8, 0) = 1
    [COLOR="#FF0000"]BeforeRightClickIsRunning = False[/COLOR]
End Sub

NB:
De oplossing van dotchie is beter

 

[gast0660]

Probeer:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean
[COLOR="#FF0000"]Application.EnableEvents = False[/COLOR]
uw macro code
[COLOR="#FF0000"]Application.EnableEvents = True[/COLOR]
End sub

 

[snb]

en maak er meteen VBA van

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
    If Intersect(Target, Range("C2:H2")) Is Nothing Then Exit Sub
    
    on error resume next
    application.enableevents=false
    for each it in target.resize(,8).specialcells(4)
       it.value=1
       it.resize(2000).clearcontents
    next

    Cancel = True
    application.enableevents=true
End Sub

 

[mvw64]

Bedankt voor de reactie

Ik ga kijken of ik hier verder mee kan