Clear all contents, formula, objects etc of cells outside a dynamic range

[Vincent88]

Hi Guys,
I found this code said to clear all contents of cells outside a dynamic range. How to modify to suit my need ? My dynamic range is
Range1 = Cells(1, 1).Resize(lastrowinRng, lastcolinRng).

Sub DeleteAllDataNotInSelection4()

  Dim vArr As Variant, UnusedRow As Long, R1str As String, R1 As Range
  Dim lastrowinRng As Long, lastcolinRng As Long
  Dim Range1 As Range
 
  lastrowinRng = Range("A" & Rows.Count).End(xlUp).Row
  lastcolinRng = Cells(1, Columns.Count).End(xlToLeft).Column
 
  Set Range1 = Cells(1, 1).Resize(lastrowinRng, lastcolinRng)
 
  Debug.Print Range1.Address
 
  Const DefinedName As String = Range1
 
  Set R1 = Range(DefinedName)
  R1str = "=" & R1.Parent.Name & "!" & R1.Address
  UnusedRow = Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row + 1
  Application.ScreenUpdating = Falseq
  R1.Copy Cells(UnusedRow, "A")
  Rows("1:" & UnusedRow - 1).Clear
  Cells(UnusedRow, "A").Resize(R1.Rows.Count, R1.Columns.Count).Cut R1
  ActiveSheet.Names.Add DefinedName, R1str
  Application.ScreenUpdating = True

End Sub

 

[maabadi]

Add Two Last lines of my code:

Sub DeleteAllDataNotInSelection4()

  Dim vArr As Variant, UnusedRow As Long, R1str As String, R1 As Range
  Dim lastrowinRng As Long, lastcolinRng As Long
  Dim Range1 As Range
 
  lastrowinRng = Range("A" & Rows.Count).End(xlUp).Row
  lastcolinRng = Cells(1, Columns.Count).End(xlToLeft).Column
 
  Set Range1 = Cells(1, 1).Resize(lastrowinRng, lastcolinRng)
  Range(Cells(lastrowinRng + 1, 1), Cells(Rows.Count, Columns.Count)).ClearContents
  Range(Cells(1, lastcolinRng + 1), Cells(Rows.Count, Columns.Count)).ClearContents
End Sub

 

[maabadi]

Or Use these two Lines:

Rows(lastrowinRng + 1 & ":" & Rows.Count).ClearContents
Columns(Split(Cells(1, lastcolinRng + 1).Address, "$")(1) & ":" & Split(Cells(1, Columns.Count).Address, "$")(1)).ClearContents

 

[Vincent88]

Hi maabadi,
Other than values to clear, I add below lines but not work ?

Columns(Split(Cells(1, lastcolinRng + 1).Address, "$")(1) & ":" & Split(Cells(1, Columns.Count).Address, "$")(1)).OLEObjects.Delete
Columns(Split(Cells(1, lastcolinRng + 1).Address, "$")(1) & ":" & Split(Cells(1, Columns.Count).Address, "$")(1)).Pictures.Delete

 Rows(lastrowinRng + 1 & ":" & Rows.Count).OLEObjects.Delete
 Rows(lastrowinRng + 1 & ":" & Rows.Count).Pictures.Delete

 

[maabadi]

Try this for shapes:

Sub DeleteAllDataNotInSelection4()
  Dim lastrowinRng As Long, lastcolinRng As Long, Range1 As Range, shp As Shape
   lastrowinRng = Range("A" & Rows.Count).End(xlUp).Row
  lastcolinRng = Cells(1, Columns.Count).End(xlToLeft).Column
 
  Set Range1 = Cells(1, 1).Resize(lastrowinRng, lastcolinRng)

    For Each shp In ActiveSheet.Shapes
            If Not Intersect(shp.TopLeftCell, Range1) Is Nothing Then
                    shp.Delete
            End If
    Next shp

 

[Vincent88]

Try this for shapes:

Sub DeleteAllDataNotInSelection4()
  Dim lastrowinRng As Long, lastcolinRng As Long, Range1 As Range, shp As Shape
   lastrowinRng = Range("A" & Rows.Count).End(xlUp).Row
  lastcolinRng = Cells(1, Columns.Count).End(xlToLeft).Column
 
  Set Range1 = Cells(1, 1).Resize(lastrowinRng, lastcolinRng)

    For Each shp In ActiveSheet.Shapes
            If Not Intersect(shp.TopLeftCell, Range1) Is Nothing Then
                    shp.Delete
            End If
    Next shp

Hi maabadi,
this does not work.