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 )

 

[edge37]

Thanks for letting me know. Glad I could help.

Hello again

Alex Blakenburg​

Can you please help me with something in your code, please? I need to create many pages that needs this code, but because this part:

Set ws = ThisWorkbook.Sheets("10A (1)")

I can only make it work for that specific sheet, If I copy the worksheet (and name it, for example "10B (1)") and apply the code, it affects only the columns in "10A (1) sheet, not in the sheet it is on. Each of the 7 tabs I need are going to be named: "10A (1)", "10B (1)", "10C (1)", "11A (1)", "11B (1)" , "11C (1)", and "11C BIO (1)".

Thank you for your assistance again.

 

[edge37]

Or should I just modify the code for each page? (Eventhough I wanted to avoid this to leave the VBA less clogged with macros, but...)

 

[Alex Blakenburg]

How are you triggering the code to run ? If it is being triggered from the ActiveSheet then all you need to do is change the Set ws line to:

    ' Set the worksheet
    Set ws = ActiveSheet

 

[edge37]

How are you triggering the code to run ? If it is being triggered from the ActiveSheet then all you need to do is change the Set ws line to:

    ' Set the worksheet
    Set ws = ActiveSheet

will try. Thank you!