For all active sheets in a workbook

Question

I have a VB script to autofit merged cells height, but it only works for the first sheet/current sheet of the workbook.

The VBA Script is originally from Autofit Merged Cells with VBA, and I made some slightly range change.

I'd like to make all my available/active sheets to run this same VB script. So, I added the following SlectedSheets code to the AutofixMergedCellHeigh VB script, but it didn't work.

Does anyone could help out? Thanks a lot!

AutofixMergedCellHeight:

enter image description here

Sub FixMerged()
    Dim mw As Single
    Dim cM As Range
    Dim rng As Range
    Dim cw As Double
    Dim rwht As Double
    Dim ar As Variant
    Dim i As Integer
    Application.ScreenUpdating = False
    'Cell Ranges below, change to suit.
    ar = Array("B32", "B33")
    For i = 1 To UBound(ar)
    On Error Resume Next
    Set rng = Range(Range(ar(i)).MergeArea.Address)
        With rng
           .MergeCells = False
            cw = .Cells(1).ColumnWidth
            mw = 0
        For Each cM In rng
            cM.WrapText = True
            mw = cM.ColumnWidth + mw
        Next
        mw = mw + rng.Cells.Count * 0.66
        .Cells(1).ColumnWidth = mw
        .EntireRow.AutoFit
        rwht = .RowHeight
        .Cells(1).ColumnWidth = cw
        .MergeCells = True
        .RowHeight = rwht
        End With
    Next i
    Application.ScreenUpdating = True
End Sub

enter image description here

I also add a new script to loop through all of the worksheets in the workbook by using a 'For Each' loop, and inserted calls for SelectSheets and FixMerged. But this way only works on the current single sheet too.

Sub WorksheetLoop()
    Dim Current As Worksheet
    For Each Current In Worksheets
        SelectSheets
        FixMerged
    Next
End Sub

@Ricardo, the images of code should show up. Please let me know if you can see them, and looking forward your help. Thanks! — MMM KKK, Mar 07 '23 at 01:15
Please copy and paste your code *as text* - images of code do not help anyone trying to help you with your problem: we'd first have to type it all out before testing... — Tim Williams, Mar 07 '23 at 03:02
@Tim, thanks for letting me know! I just updated the code as text and look forward to your review and help. Thanks! — MMM KKK, Mar 07 '23 at 03:29

VBasic2008 · Answer 1 · 2023-03-07T06:19:20.693

Passing a Worksheet Object to Another Procedure

The Calling Procedure

Sub FixMergedAll()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    
    For Each ws In wb.Worksheets
        FixMergedCells ws
    Next ws

    Application.ScreenUpdating = True

End Sub

The Called Procedure

' *** designates the locations of the introduced changes. For the rest, you're on your own.

Sub FixMergedCells(ByVal ws As Worksheet) ' ***
    
    Dim mw As Single
    Dim cM As Range
    Dim rng As Range
    Dim cw As Double
    Dim rwht As Double
    Dim ar As Variant
    Dim i As Long ' ***
    
    'Cell Ranges below, change to suit.
    ar = Array("B32", "B33")
    
    For i = LBound(ar) To UBound(ar) ' ***
        
        On Error Resume Next
        
        Set rng = ws.Range(ar(i)).MergeArea ' ***
        
        With rng
           
           .MergeCells = False
            cw = .Cells(1).ColumnWidth
            mw = 0
            
            For Each cM In rng
                cM.WrapText = True
                mw = cM.ColumnWidth + mw
            Next
            
            mw = mw + rng.Cells.Count * 0.66
            .Cells(1).ColumnWidth = mw
            .EntireRow.AutoFit
            rwht = .RowHeight
            .Cells(1).ColumnWidth = cw
            .MergeCells = True
            .RowHeight = rwht
        
        End With
    
    Next i

End Sub

You're welcome. I have simplified this `Set rng = ws.Range(ar(i)).MergeArea` only a few minutes ago. Also, I have only now noticed that you are under `Option Base 1` so the `1` could have stayed although you're not using the indexes of the array in any calculations so rather stick with the recommended `LBound(ar)`. But using `Option Base 1` isn't recommended at all (unless you're forced to). — VBasic2008, Mar 07 '23 at 06:26
Thanks for your explanations and suggestions! I'll remove "Option Base 1" from the code since it's not necessary. I appreciate your kind help and time. — MMM KKK, Mar 07 '23 at 06:48
@MMMKKK if the answer worked, please remember to mark it (tic the green checkmark), so others can find it — Ricardo Diaz, Mar 07 '23 at 14:07

For all active sheets in a workbook

1 Answers1

Passing a Worksheet Object to Another Procedure