CODEWITHSUNDEEP
excelvba
leoflute
leoflute

Reputation: 1

Looping a vba code so it works an many worksheets in a workbook

I am looking for some help in having a specific code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, 
    Cancel As Boolean)
    If Not Intersect(Target, Range("B1:B10")) Is Nothing Then
        Application.EnableEvents = False
        If ActiveCell.Value = ChrW(&H2713) Then
            ActiveCell.ClearContents
        Else
            ActiveCell.Value = ChrW(&H2713)
        End If
        Cancel = True
    End If
    Application.EnableEvents = True
End Sub

so that it works on many sheets in a workbook. I have scoured the internet and found a code or two for looping a code, but I'm having trouble with how the code is supposed to look within the looping code. Any help would be greatly appreciated. Thank you!!

I tried changing the Private Sub line to : Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _ ByVal Target As Range, ByVal Cancel As Boolean) but received a Complie error: Procedure declaration does not match description of event or procedure having the same name. I'm very sorry, but I am very new to VBA and need help on how to word the code .....

Upvotes: 0

Views: 117

Answers (1)

VBasic2008
VBasic2008

Reputation: 54948

Workbook_SheetBeforeDoubleClick (in ThisWorkbook)

  • Adjust the values in the Exceptions array.
  • Assuming that many worksheets means all, except a few whose names will be in the Exceptions array.

Workbook Module: ThisWorkbook

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
                                            ByVal Target As Range, _
                                            Cancel As Boolean)
    
    On Error GoTo clearError
    
    Dim Exceptions As Variant
    Exceptions = Array("Sheet1", "Sheet2")
    If UBound(Exceptions) >= LBound(Exceptions) Then
        If Not IsError(Application.Match(Sh.Name, Exceptions, 0)) Then
            'Debug.Print "Is in Exceptions."
            GoTo ProcExit
        End If
    End If
    
    If Intersect(Target, Sh.Range("B1:B10")) Is Nothing Then
        'Debug.Print "Not in Exceptions, but out of bounds."
        GoTo ProcExit
    End If
    
    Application.EnableEvents = False
    
    If ActiveCell.Value = ChrW(&H2713) Then
        ActiveCell.ClearContents
    Else
        ActiveCell.Value = ChrW(&H2713)
    End If
    Cancel = True
    
CleanExit:
    Application.EnableEvents = True

ProcExit:
    Exit Sub

clearError:
    Debug.Print "Run-time Error '" & Err.Number & "': " & Err.Description
    On Error GoTo 0
    GoTo CleanExit

End Sub

Upvotes: 0

Related Questions