Toggle hide/unhide columns without affecting tables or text boxes on top

[edge37]

Hi! I'm trying this code to toggle hide/unhide columns in my worksheet:

Sub ToggleColumnsAFtoAIWithoutAffectingObjects()
    Dim ws As Worksheet
    Dim targetColumns As Range
    Dim obj As Shape

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("10A (1)")
    
    ' Set the target columns
    Set targetColumns = ws.Columns("AF:AI")
    
    ' Check current visibility and toggle
    If targetColumns.EntireColumn.Hidden Then
        targetColumns.EntireColumn.Hidden = False ' Unhide columns
    Else
        targetColumns.EntireColumn.Hidden = True ' Hide columns
    End If

    ' Loop through shapes (objects) and ensure they remain visible
    For Each obj In ws.Shapes
        ' If the shape's top-left cell overlaps the target columns, make it visible
        If Not Intersect(ws.Range(obj.TopLeftCell.Address), targetColumns) Is Nothing Then
            obj.Visible = True
        End If
    Next obj
End Sub

But when I do so, the objects on top of those columns (tables, drawings or text boxes) gets resized. Is there a way to hide/show columns in a way I can keep objects on top of them in the same place and size? Pic I sent show before/after applying the code.

Thanks

 

[Alex Blakenburg]

See if the code in blue fixes it for you.
Technically you shouldn't need to run this each time, so see if you want to remove after it has changed the property to FreeFloating.

Sub ToggleColumnsAFtoAIWithoutAffectingObjects()
    Dim ws As Worksheet
    Dim targetColumns As Range
    Dim obj As Shape

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("10A (1)")
    
    ' Set the target columns
    Set targetColumns = ws.Columns("AF:AI")
    
    For Each obj In ws.Shapes
        ' If the shape's top-left cell overlaps the target columns, make it visible
        If Not Intersect(ws.Range(obj.TopLeftCell.Address), targetColumns) Is Nothing Then
            obj.Placement = xlFreeFloating
        End If
    Next obj
    
    ' Check current visibility and toggle
    If targetColumns.EntireColumn.Hidden Then
        targetColumns.EntireColumn.Hidden = False ' Unhide columns
    Else
        targetColumns.EntireColumn.Hidden = True ' Hide columns
    End If

    ' Loop through shapes (objects) and ensure they remain visible
    For Each obj In ws.Shapes
        ' If the shape's top-left cell overlaps the target columns, make it visible
        If Not Intersect(ws.Range(obj.TopLeftCell.Address), targetColumns) Is Nothing Then
            obj.Visible = True
        End If
    Next obj
End Sub

 

[edge37]

Fantastic, working like a charm, thank you.

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.

 

[Peter_SSs]

Not related to your question about the shapes but if you are interested, this section ..

' Check current visibility and toggle
If targetColumns.EntireColumn.Hidden Then
    targetColumns.EntireColumn.Hidden = False ' Unhide columns
Else
    targetColumns.EntireColumn.Hidden = True ' Hide columns
End If

.. could be replaced with this

'Toggle current visibility
targetColumns.Hidden = Not targetColumns.Hidden

(noting also that .EntireColumn has been removed as unnecessary since targetColumns was already defined as entire columns )