Need Macro Delete the yellow highlighted column only PPT

[sksanjeev786]

Hi Team,

I need to delete the yellow highlighted column on the table in the PPT table
and table selection pane is "Content Placeholder 8 " so i have almost 50+ slides where we have yellow highlighted so need to delete those column

 

[sksanjeev786]

Hi Team,

I need to delete the yellow highlighted column on the table in the PPT table
and table selection pane is "Content Placeholder 8 " so i have almost 50+ slides where we have yellow highlighted so need to delete those column


View attachment 97525

Hi Team,

any update on the above query?

Thanks in advance

Regards
Sanjeev

 

[Domenic]

A few questions...

1. Will the highlight for the column always occur on the last row of the table? Or can it occur on any row?
2. Will there always be only one column highlighted? Or can there be more? If more, delete all highlighted columns?
3. Is the highlighted area made up of two merged cells? If so, delete both columns?

 

[sksanjeev786]

A few questions...

1. Will the highlight for the column always occur on the last row of the table? Or can it occur on any row?
2. Will there always be only one column highlighted? Or can there be more? If more, delete all highlighted columns?
3. Is the highlighted area made up of two merged cells? If so, delete both columns?

Hi Domenic,

Thanks for the response. And here is my points based on the above.

1. Yes, highlighted columns always occur on only last row of the table.
2. Yes, We have multiple columns with highlighted column and that column also need to be deleted.
3. Yes, I need to delete both the columns which are made up of merge cells.

Let us know if you need more details.

Regards
Sanjeev.

 

[Domenic]

The following macro loops through each slide with the active presentation, and then loops through each placeholder with the slide. Then, for each placeholder, it checks whether it contains a table. If so, it deletes all columns where the corresponding cell in the last row is highlighted in yellow...

Option Explicit

Sub DeleteHighlightedColumnsFromAllTables()

    Dim highlightColor As Long
    highlightColor = RGB(255, 255, 0) 'yellow
    
    Dim currentSlide As Slide
    Dim currentShape As Shape
    For Each currentSlide In ActivePresentation.Slides
        For Each currentShape In currentSlide.Shapes.Placeholders
            If currentShape.HasTable Then
                DeleteHighlightedColumnsFromTable currentShape.Table, highlightColor
            End If
        Next currentShape
    Next currentSlide
    
    MsgBox "Completed!", vbExclamation
    
End Sub

Private Sub DeleteHighlightedColumnsFromTable(ByVal targetTable As Table, ByVal highlightColor As Long)

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim columnIndex As Long
    With targetTable
        lastRow = .Rows.Count
        lastColumn = .Columns.Count
        For columnIndex = lastColumn To 1 Step -1
            If .Cell(lastRow, columnIndex).Shape.Fill.ForeColor.RGB = highlightColor Then
                .Columns(columnIndex).Delete
            End If
        Next columnIndex
    End With
    
End Sub

Hope this helps!

 

[sksanjeev786]

The following macro loops through each slide with the active presentation, and then loops through each placeholder with the slide. Then, for each placeholder, it checks whether it contains a table. If so, it deletes all columns where the corresponding cell in the last row is highlighted in yellow...

Option Explicit

Sub DeleteHighlightedColumnsFromAllTables()

    Dim highlightColor As Long
    highlightColor = RGB(255, 255, 0) 'yellow
   
    Dim currentSlide As Slide
    Dim currentShape As Shape
    For Each currentSlide In ActivePresentation.Slides
        For Each currentShape In currentSlide.Shapes.Placeholders
            If currentShape.HasTable Then
                DeleteHighlightedColumnsFromTable currentShape.Table, highlightColor
            End If
        Next currentShape
    Next currentSlide
   
    MsgBox "Completed!", vbExclamation
   
End Sub

Private Sub DeleteHighlightedColumnsFromTable(ByVal targetTable As Table, ByVal highlightColor As Long)

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim columnIndex As Long
    With targetTable
        lastRow = .Rows.Count
        lastColumn = .Columns.Count
        For columnIndex = lastColumn To 1 Step -1
            If .Cell(lastRow, columnIndex).Shape.Fill.ForeColor.RGB = highlightColor Then
                .Columns(columnIndex).Delete
            End If
        Next columnIndex
    End With
   
End Sub

Hope this helps!

Wow!!!! Perfect!!!

Thank you so much for your help on this... really appreciate your hard work!!

Regards
Sanjeev

 

[Domenic]

That's great, I'm glad I could help. And thanks for the feedback.

Cheers!

 

[sksanjeev786]

That's great, I'm glad I could help. And thanks for the feedback.

Cheers!

Hi Sir,

Can we have an option like before deleting can I get Msg box saying "Are you sure you want to delete this column" If "yes" then delete that column and move to the next slide and if No exit and also can we have it with Custom slides (1-33,44-55)

Thanks in advance.

Regards
Sanjeev

 

[Domenic]

Okay, I have amended the code so that it specifies the desired slides. And for each highlighted column, a message box is displayed and asks whether to delete it. The user can click on Yes to the delete the column, No to skip the column, and Cancel to exit the sub.

Option Explicit

Sub DeleteHighlightedColumnsFromAllTables()

    Dim highlightColor As Long
    highlightColor = RGB(255, 255, 0) 'yellow
    
    Dim currentShape As Shape
    Dim slideIndex As Long
    For slideIndex = 1 To 55
        Select Case slideIndex
            Case 1 To 33, 44 To 55
                For Each currentShape In ActivePresentation.Slides(slideIndex).Shapes.Placeholders
                    If currentShape.HasTable Then
                        If Not DeleteHighlightedColumnsFromTable(currentShape.Table, highlightColor) Then Exit Sub
                    End If
                Next currentShape
        End Select
    Next slideIndex
    
    MsgBox "Completed!", vbExclamation
    
End Sub

Private Function DeleteHighlightedColumnsFromTable(ByVal targetTable As Table, ByVal highlightColor As Long) As Boolean

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim columnIndex As Long
    Dim response As VbMsgBoxResult
    Dim slideNameAndColumnHeader As String
    
    With targetTable
        lastRow = .Rows.Count
        lastColumn = .Columns.Count
        For columnIndex = lastColumn To 1 Step -1
            If .Cell(lastRow, columnIndex).Shape.Fill.ForeColor.RGB = highlightColor Then
                .Parent.Parent.Select 'go to slide (optional)
                slideNameAndColumnHeader = .Parent.Parent.Name & " - " & .Cell(1, columnIndex).Shape.TextFrame2.TextRange.Text
                response = MsgBox("Are you sure you want to delete this column?", vbQuestion + vbYesNoCancel, slideNameAndColumnHeader)
                If response = vbCancel Then
                    DeleteHighlightedColumnsFromTable = False
                    Exit Function
                End If
                If response = vbYes Then
                    .Columns(columnIndex).Delete
                End If
            End If
        Next columnIndex
    End With
    
    DeleteHighlightedColumnsFromTable = True
    
End Function

Hope this helps!

 

[sksanjeev786]

Okay, I have amended the code so that it specifies the desired slides. And for each highlighted column, a message box is displayed and asks whether to delete it. The user can click on Yes to the delete the column, No to skip the column, and Cancel to exit the sub.

Option Explicit

Sub DeleteHighlightedColumnsFromAllTables()

    Dim highlightColor As Long
    highlightColor = RGB(255, 255, 0) 'yellow
   
    Dim currentShape As Shape
    Dim slideIndex As Long
    For slideIndex = 1 To 55
        Select Case slideIndex
            Case 1 To 33, 44 To 55
                For Each currentShape In ActivePresentation.Slides(slideIndex).Shapes.Placeholders
                    If currentShape.HasTable Then
                        If Not DeleteHighlightedColumnsFromTable(currentShape.Table, highlightColor) Then Exit Sub
                    End If
                Next currentShape
        End Select
    Next slideIndex
   
    MsgBox "Completed!", vbExclamation
   
End Sub

Private Function DeleteHighlightedColumnsFromTable(ByVal targetTable As Table, ByVal highlightColor As Long) As Boolean

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim columnIndex As Long
    Dim response As VbMsgBoxResult
    Dim slideNameAndColumnHeader As String
   
    With targetTable
        lastRow = .Rows.Count
        lastColumn = .Columns.Count
        For columnIndex = lastColumn To 1 Step -1
            If .Cell(lastRow, columnIndex).Shape.Fill.ForeColor.RGB = highlightColor Then
                .Parent.Parent.Select 'go to slide (optional)
                slideNameAndColumnHeader = .Parent.Parent.Name & " - " & .Cell(1, columnIndex).Shape.TextFrame2.TextRange.Text
                response = MsgBox("Are you sure you want to delete this column?", vbQuestion + vbYesNoCancel, slideNameAndColumnHeader)
                If response = vbCancel Then
                    DeleteHighlightedColumnsFromTable = False
                    Exit Function
                End If
                If response = vbYes Then
                    .Columns(columnIndex).Delete
                End If
            End If
        Next columnIndex
    End With
   
    DeleteHighlightedColumnsFromTable = True
   
End Function

Hope this helps!

Loved it!!!

Thanks you, So much Sir for your time and hard work on this

Regards
Sanjeev