How Do I Delete Pictures and Text from Cell Ranges of Multiple Columns?

[njpamdnc]

Hello...My name is Robert, and I am a middle school math teacher who is almost finished completing modifications of his gradebook for the following school year. I am looking for a formula or macro that will delete objects such as pictures and text from cell ranges of multiple columns. I have a worksheet called "pow grader". I want the following 180 columns of cell ranges to be deleted: E3 to E202, H3 to H202, K3 to K202, etc.(every 3rd column from Column E to Column TV within Row 3 to Row 202. Any assistance you can provide will be greatly appreciated.

 

[Domenic]

Try the following code, which needs to be placed in a regular module (Visual Basic Editor >> Insert >> Module)...

Option Explicit

Sub DeletePicturesAndClearContents()

    Dim targetRange As Range
    Dim columnIndex As Long
    
    Set targetRange = Worksheets("pow grader").Range("E3:TV202")
    
    With targetRange
        For columnIndex = 1 To .Columns.Count Step 3
            .Columns(columnIndex).ClearContents
            Call DeletePictures(.Columns(columnIndex))
        Next columnIndex
    End With
    
    MsgBox "Completed!", vbExclamation
    
End Sub

Sub DeletePictures(ByVal rng As Range)

    Dim pic As Picture
    Dim ws As Worksheet
    
    Set ws = rng.Parent
    
    For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, rng) Is Nothing Then
            pic.Delete
        End If
    Next pic
    
End Sub

Hope this helps!

 

[njpamdnc]

Domenic...When I tried to run the macro the following message appeared:

Run-Time Error '13':


Type mismatch

When I pressed 'Debug' Excel highlighted the following data:


For Each pic In ws.Pictures

Try the following code, which needs to be placed in a regular module (Visual Basic Editor >> Insert >> Module)...

Option Explicit

Sub DeletePicturesAndClearContents()

    Dim targetRange As Range
    Dim columnIndex As Long
    
    Set targetRange = Worksheets("pow grader").Range("E3:TV202")
    
    With targetRange
        For columnIndex = 1 To .Columns.Count Step 3
            .Columns(columnIndex).ClearContents
            Call DeletePictures(.Columns(columnIndex))
        Next columnIndex
    End With
    
    MsgBox "Completed!", vbExclamation
    
End Sub

Sub DeletePictures(ByVal rng As Range)

    Dim pic As Picture
    Dim ws As Worksheet
    
    Set ws = rng.Parent
    
    For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, rng) Is Nothing Then
            pic.Delete
        End If
    Next pic
    
End Sub

Hope this helps!

 

[JoeMo]

If your pictures use the default naming convention (Picture 1, Picture 2, ...),you could try this small modification:

Sub DeletePictures(ByVal rng As Range)
    Dim pic As Shape
    Dim ws As Worksheet
    
    Set ws = rng.Parent
    
    For Each pic In ws.Shapes
        If pic.Name Like "Picture*" Then
            If Not Intersect(pic.TopLeftCell, rng) Is Nothing Then
                pic.Delete
            End If
        End If
    Next pic
End Sub

 

[Domenic]

The error occurs because the Pictures collection seems to include other types of objects in addition to Picture objects. And since the variable pic is typed as Picture, we get a type mismatch error. Accordingly, I have amended DeletePictures so that it loops through each shape, and then checks whether it's a picture, etc.

Sub DeletePictures(ByVal rng As Range)

    Dim shp As Shape
    Dim ws As Worksheet
    
    Set ws = rng.Parent
    
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(shp.TopLeftCell, rng) Is Nothing Then
                shp.Delete
            End If
        End If
    Next shp
    
End Sub

**Edit**

Sorry Joe, I dilly dallied, then I posted, and then realized that you posted a solution. Since mine is similar but not quite the same, I won't delete mine.

 

[JoeMo]

The error occurs because the Pictures collection seems to include other types of objects in addition to Picture objects. And since the variable pic is typed as Picture, we get a type mismatch error. Accordingly, I have amended DeletePictures so that it loops through each shape, and then checks whether it's a picture, etc.

Sub DeletePictures(ByVal rng As Range)

    Dim shp As Shape
    Dim ws As Worksheet
    
    Set ws = rng.Parent
    
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(shp.TopLeftCell, rng) Is Nothing Then
                shp.Delete
            End If
        End If
    Next shp
    
End Sub

**Edit**

Sorry Joe, I dilly dallied, then I posted, and then realized that you posted a solution. Since mine is similar but not quite the same, I won't delete mine.

No apology needed Domenic - your modification is better than mine as it allows for the pictures to have names other than the Excel default "Picture n" (n = 1,2,3, ...). I couldn't remember the shp.Type syntax

 

[njpamdnc]

Domenic and Joe...Your assistance has allowed me to achieve success...Thank You!!!

Robert

No apology needed Domenic - your modification is better than mine as it allows for the pictures to have names other than the Excel default "Picture n" (n = 1,2,3, ...). I couldn't remember the shp.Type syntax

 

[njpamdnc]

No apology needed Domenic - your modification is better than mine as it allows for the pictures to have names other than the Excel default "Picture n" (n = 1,2,3, ...). I couldn't remember the shp.Type syntax

Joe...As I previously stated the following VBA works. However, I also want another version of it that doesn't require a specific worksheet name such as "pow grader". An sctive worksheet command will be fine. I also don't need "the following 180 columns of cell ranges to be deleted: E3 to E202, H3 to H202, K3 to K202, etc.(every 3rd column from Column E to Column TV within Row 3 to Row 202.)" In other words, I simply want "pow grader" to be replaced with an active sheet command and a cell range command that consists of multiple ranges consisting of adjacent cells such as C3:AU202 and CO3:TV202. I hope I didn't confuse you.


Option Explicit


Sub DeletePicturesAndClearContents()


Dim targetRange As Range
Dim columnIndex As Long

Set targetRange = Worksheets("pow grader").Range("E3:TV202")

With targetRange
For columnIndex = 1 To .Columns.Count Step 3
.Columns(columnIndex).ClearContents
Call DeletePictures(.Columns(columnIndex))
Next columnIndex
End With

MsgBox "Completed!", vbExclamation

End Sub


Sub DeletePictures(ByVal rng As Range)
Dim pic As Shape
Dim ws As Worksheet

Set ws = rng.Parent

For Each pic In ws.Shapes
If pic.Name Like "Picture*" Then
If Not Intersect(pic.TopLeftCell, rng) Is Nothing Then
pic.Delete
End If
End If
Next pic
End Sub

 

[njpamdnc]

Hello Again Domenic...I hope I am not in violation of any MrExcel rules with this message. The reason being I recently sent JoMo a detailed message regarding a few modifications of the following code below. I didn't want to further complicate my request by sending him another message stating I figured out the answers to my previous problems, but there now is an additional issue that requires assistance beyond my Excel IQ. I recently discovered the code below that you have created for me deletes all text and all of the pictures but no objects in my active worksheet. My spreadsheet contains 67 pictures and 25 objects shown in the "Selection Pane" of "Find & Select". After I run the macro, the Selection Pane doesn't show the 67 pictures, but it still shows the 25 objects. After several long and frustrating hours of research, I discovered and tested with success two short macros that clear all contents and delete all pictures and objects. However, I don't know how to connect the two subroutines to run in the MS VB Module window. The macros are located just beyond the solid black line after the original macro. After I receive a solution to this problem, I can finally take a break until I encounter another coding issue. Any assistance you can provide will be greatly appreciated.


Robert




Option Explicit




Sub DeletePicturesAndClearContents()




Dim targetRange As Range
Dim columnIndex As Long


Set targetRange = Worksheets("pow grader").Range("E3:TV202")


With targetRange
For columnIndex = 1 To .Columns.Count Step 3
.Columns(columnIndex).ClearContents
Call DeletePictures(.Columns(columnIndex))
Next columnIndex
End With


MsgBox "Completed!", vbExclamation


End Sub




Sub DeletePictures(ByVal rng As Range)
Dim pic As Shape
Dim ws As Worksheet


Set ws = rng.Parent


For Each pic In ws.Shapes
If pic.Name Like "Picture*" Then
If Not Intersect(pic.TopLeftCell, rng) Is Nothing Then
pic.Delete
End If
End If
Next pic
End Sub
________________________________________________________________________________


Sub VBA_Clear_Contents_Range()
Range("A2:D10").ClearContents
End Sub
------------------------------------------------------------------------------
Public Sub delete_picture()
For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, [E2:E9]) Is Nothing Then shp.Delete
Next
End Sub