Keep only a range in all sheets - VBA

Question

I want a fixed range to be kept in all worksheets and rest has to be deleted. When I run my code, it only works for the first sheet, and nothing happens on other sheets.

Sub ClearAllExceptSelection()

    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    Dim xUpdate As Boolean
    On Error Resume Next

    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the ranges want to keep", "Input", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub

    xUpdate = Application.ScreenUpdating

    Application.ScreenUpdating = False
    For Each xCell In ActiveSheet.UsedRange
        If Intersect(xCell, xRg) Is Nothing Then
            xCell.Clear
        End If
    Next
    Application.ScreenUpdating = xUpdate

End Sub

Sub WorksheetLoop()

    Dim WS_Count As Integer
    Dim I As Integer

    ' Set WS_Count equal to the number of worksheets in the active workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    ' Begin the loop.
    For I = 1 To WS_Count
        Call ClearAllExceptSelection
    Next I

End Sub

Please help me solve this bug.

Thanks in advance.

Answer 1

I think you are after something like the code below:

Option Explicit

Sub WorksheetLoop()

    Dim i As Long
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String

    ' first set the Exception Range
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the ranges want to keep", "Input", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    ' loop through worksheets
    For i = 1 To ThisWorkbook.Worksheets.Count
        ' ~~~ Call your Sub, pass the Worksheet and Range objects
        ClearAllExceptSelection ThisWorkbook.Worksheets(i), xRg
    Next i

    Application.ScreenUpdating = True

End Sub

'==============================================================

Sub ClearAllExceptSelection(Sht As Worksheet, xRng As Range)

    Dim xCell As Range
    Dim LocRng As Range

    Set LocRng = Sht.Range(xRng.Address) ' set the local sheet's range using the selected range address

    ' loop through Used range in sheet, and check if intersects with Exception range
    For Each xCell In Sht.UsedRange.Cells
        If Application.Intersect(xCell, LocRng) Is Nothing Then
            xCell.Clear
        End If
    Next xCell

End Sub