Clear content of cells outside area of interest

[yploo]

Hi all,

I am looking for a way to clear the content of all the cells outside my area of interest (designated by the orange oval):

Close up, it looks like this:

I would like to clear the content of ALL the cells that are not encircled, and including those coloured in orange.

How can this be done?

Thank you very much in advance!!!

 

[yploo]

Sorry for not clarifying them earlier -

I would like to mirror the content clearing of the PNG sheet in the TIFF sheet, both of which will be placed in the same workbook.

The 4 AOIs are of the same size. But they are not neatly aligned with each other.

 

[Peter_SSs]

I'm not sure I recall all the detail of what was being done before but try this with a copy of the workbook.
Copy both codes and run the ClearOutside_v4 code

Sub ClearOutside_v4()
  Dim rFound As Range, cRange As Range
  Dim i As Long, j As Long, k As Long, w As Long, h As Long, lc As Long, rc As Long, tr As Long, br As Long
  
  Application.ScreenUpdating = False
  With Sheets("PNG").UsedRange
    For i = 1 To 4
      If i < 3 Then
        Set rFound = .Find(What:=255, LookAt:=xlWhole, SearchOrder:=xlByColumns)
        lc = rFound.Column
        j = 1
        Do Until rFound.Offset(j).Value <> 255
          j = j + 1
        Loop
        With .Rows(rFound.Row + j / 2)
          rc = .Find(What:=255, After:=.Cells(lc + 1), LookAt:=xlWhole).Column
          If .Cells(rc + 1).Value = 255 Then rc = rc + 1
          w = rc - lc + 1
          k = 0
          Do Until .Cells(rc + k) <> 255 Or rc + k = .Cells.Count
            k = k + 1
          Loop
          rc = rc + k
          If .Columns.Count - rc < w Then rc = .Columns.Count
          k = 0
          Do Until IsEmpty(.Cells(lc - k).Value) Or lc - k = 1
            k = k + 1
          Loop
          lc = lc - k
        End With
        With .Columns(lc + (rc - lc) / 2)
          tr = .Find(What:=255, After:=.Cells(rFound.Row + j / 2), LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
          If .Cells(tr - 1).Value = 255 Then tr = tr - 1
          br = .Find(What:=255, After:=.Cells(rFound.Row + j / 2), LookAt:=xlWhole, SearchDirection:=xlNext).Row
          If .Cells(br + 1).Value = 255 Then br = br + 1
          h = br - tr + 1
          k = 0
          Do Until .Cells(br + k) <> 255 Or br + k = .Cells.Count
            k = k + 1
          Loop
          br = br + k
          If .Rows.Count - br < h Then br = .Rows.Count
          k = 0
          Do Until IsEmpty(.Cells(tr - k).Value) Or tr - k = 1
            k = k + 1
          Loop
          tr = tr - k
        End With
      Else
        If i = 3 Then Set rFound = .Find(What:=255, LookAt:=xlWhole, SearchOrder:=xlByRows)
        If i = 3 Then
          lc = .Rows(1).SpecialCells(xlConstants).Cells(1).Column
        Else
          lc = .SpecialCells(xlCellTypeLastCell).CurrentRegion.Column
        End If
        rc = .Columns.Count
        tr = IIf(i = 3, 1, rFound.Row + h + 1)
        br = IIf(i = 3, rFound.Row + h + 1, .Rows.Count)
      End If
      Set cRange = .Range(.Cells(tr, lc), .Cells(br, rc))
      ClearCircle cRange
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

Sub ClearCircle(rng As Range)
  Dim PNG As Worksheet, TIFF As Worksheet
  Dim rCol As Range, rngFound As Range
  
  Set PNG = Sheets("PNG")
  Set TIFF = Sheets("TIFF")
  For Each rCol In rng.Columns
    With rCol
      Set rngFound = Nothing
        Set rngFound = .Find(What:=255, After:=.Cells(.Rows.Count), LookAt:=xlWhole, SearchDirection:=xlNext)
        If rngFound Is Nothing Then
          rCol.ClearContents
          TIFF.Range(rCol.Address).ClearContents
        Else
          If rngFound.Row > .Row Then
            .Cells(1).Resize(rngFound.Offset(-1).Row - .Row + 1).ClearContents
            TIFF.Range(.Cells(1).Address, rngFound.Offset(-1).Address).ClearContents
          End If
          Set rngFound = .Find(What:=255, After:=.Cells(1), LookAt:=xlWhole, SearchDirection:=xlPrevious)
          If rngFound.Row < .Cells(.Rows.Count).Row Then
            .Cells(rngFound.Row - .Row + 1).Resize(.Row + .Rows.Count - rngFound.Row).ClearContents
            TIFF.Range(rngFound.Offset(1).Address, .Cells(.Rows.Count).Address).ClearContents
          End If
        End If
    End With
  Next rCol
  rng.Replace What:=255, Replacement:="", LookAt:=xlWhole
  TIFF.Range(rng.Address).Replace What:=255, Replacement:="", LookAt:=xlWhole
End Sub

 

[yploo]

I copied both codes and tried to run ClearOutside_v4, but there is an error: "Error 91 Object variable or With block variable not set".

 

[Peter_SSs]

I copied both codes and tried to run ClearOutside_v4, but there is an error: "Error 91 Object variable or With block variable not set".

My test was done with the sample worksheet you provided copied twice with one renamed 'PNG' and one renamed 'TIFF'. No errors reported and cells cleared as I understand your requirement.

What did you test with?

 

[yploo]

I just tried to run the code with a duplicate of the sample worksheet, one renamed "PNG" and the other "TIFF", just like you did. The exact same error came out...

 

[Peter_SSs]

I just tried to run the code with a duplicate of the sample worksheet, one renamed "PNG" and the other "TIFF", just like you did. The exact same error came out...

Can you provide a copy of that file, including the two worksheets and the vba code, via a link as before?

 

[yploo]

Here is the WeTransfer link: https://we.tl/t-igb9cP7UKg

Thank you very much again, Peter, for your help ?

 

[Peter_SSs]

There could still be a problem with my code, but I was of the understanding that the only "255" values in the worksheets were part of the boundaries of your areas of interest. That is not the case with that sample file. Can you clarify?

BTW, the code should be in a standard module (eg Module1) not in the ThisWorkbook module. This is not related to the error though.

 

[yploo]

I was of the understanding that the only "255" values in the worksheets were part of the boundaries of your areas of interest. That is not the case with that sample file.

Are you referring to the A256 cell with value 255?

Sorry I overlooked that. Column A is actually not useful so it can be deleted from both the "PNG" and "TIFF" sheets. But even so, running the code still results in the exact same error...

 

[Peter_SSs]

Are you referring to the A256 cell with value 255?

Sorry I overlooked that. Column A is actually not useful so it can be deleted from both the "PNG" and "TIFF" sheets.

Yes, I was referring to that.
In the code below, I have assumed that you have removed those columns. The removal can be added to the code though if required.

But even so, running the code still results in the exact same error...

Yes, I had an error of logic in the code (resulting from me pre-deleting a lot of the excess rows & columns to make the sheets a bit smaller for testing)
I think I have corrected that particular problem with this code but I have not done much testing with differently aligned circles so that might still throw up some more issues yet.
You will still need the ClearCircle procedure but that has not changed from last time.

?

Sub ClearOutside_v5()
  Dim rFound As Range, cRange As Range
  Dim i As Long, j As Long, k As Long, w As Long, h As Long
  Dim lcc As Long, rcc As Long, tcr As Long, bcr As Long, lc As Long, rc As Long, tr As Long, br As Long
  
  Application.ScreenUpdating = False
  With Sheets("PNG").UsedRange
    For i = 1 To 4
      If i < 3 Then
        Set rFound = .Find(What:=255, LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlNext, SearchOrder:=xlByColumns)
        lcc = rFound.Column
        j = 1
        Do Until rFound.Offset(j).Value <> 255
          j = j + 1
        Loop
        With .Rows(rFound.Row + IIf(j = 1, 0, j / 2))
          rcc = .Find(What:=255, LookIn:=xlFormulas, After:=.Cells(lcc + 1), LookAt:=xlWhole).Column
          If .Cells(rcc + 1).Value = 255 Then rcc = rcc + 1
          w = rcc - lcc + 1
          k = 0
          Do Until .Cells(rcc + k) <> 255 Or rcc + k = .Cells.Count
            k = k + 1
          Loop
          rc = rcc + k
          If .Columns.Count - rc < w Then rc = .Columns.Count
          k = 0
          Do Until IsEmpty(.Cells(lcc - k).Value) Or lcc - k = 1
            k = k + 1
          Loop
          lc = lcc - k
        End With
        With .Columns(lcc + (rcc - lcc) / 2)
          tcr = .Find(What:=255, After:=.Cells(rFound.Row + j / 2), LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
          If .Cells(tcr - 1).Value = 255 Then tcr = tcr - 1
          bcr = .Find(What:=255, After:=.Cells(rFound.Row + j / 2), LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlNext).Row
          If .Cells(bcr + 1).Value = 255 Then bcr = bcr + 1
          h = bcr - tcr + 1
          k = 0
          Do Until .Cells(bcr + k) <> 255 Or bcr + k = .Cells.Count
            k = k + 1
          Loop
          br = bcr + k
          If .Rows.Count - br < h Then br = .Rows.Count
          k = 0
          Do Until IsEmpty(.Cells(tcr - k).Value) Or tcr - k = 1
            k = k + 1
          Loop
          tr = tcr - k
        End With
      Else
        If i = 3 Then
          Set rFound = .Find(What:=255, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
          lc = .Rows(1).SpecialCells(xlConstants).Cells(1).Column
        Else
          lc = .SpecialCells(xlCellTypeLastCell).CurrentRegion.Column
        End If
        rc = .Columns.Count
        tr = IIf(i = 3, 1, rFound.Row + h + 1)
        br = IIf(i = 3, rFound.Row + h + 1, .Rows.Count)
      End If
      Set cRange = .Range(.Cells(tr, lc), .Cells(br, rc))
      ClearCircle cRange
    Next i
  End With
  Application.ScreenUpdating = True
End Sub