VBA -- Call Function Not Running Macros Properly

[PartyPanda]

Hi There,

I'm quite new to VBA and have subs that automatically adjusts row heights for me in 14 separate sheets. The sub is almost identical in each sheet, just the ar Array changes as the rows I want to adjust are not all the same in each sheet. When I am in the active sheet and run the macro 'FixMerged' (it is assigned to a button), it works perfectly, and does exactly what it should.

Since I have 14 sheets and I need to run 14 macros, I wanted to create one short macro to run them all at once using the Call() rather than having to go into each sheet and clicking the buttons to run the macro.

For some reason though, when I run the macro by calling it, it doesn't work properly. What happens is all the rows just adjust to the height of 40, which it's grabbing from this chunk of code here:



rng.RowHeight = rwht
If rng.RowHeight < 40 Then
rng.RowHeight = 40
Else
rng.RowHeight = rwht
End If




Here is the row height adjust macro:


Option ExplicitSub FixMerged() 'Excel VBA to autofit merged cells
ActiveSheet.Unprotect Password:="PASSWORD"
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("B8", "B13", "B16", "B20", "B24", "B28", "B30", "B35", "B36", "B41", "B45")


For i = 0 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
rng.MergeCells = False
cw = rng.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
rng.Cells(1).ColumnWidth = mw
rng.EntireRow.AutoFit
rwht = rng.RowHeight
rng.Cells(1).ColumnWidth = cw
rng.MergeCells = True
rng.RowHeight = rwht
If rng.RowHeight < 40 Then
rng.RowHeight = 40
Else
rng.RowHeight = rwht
End If
rng.Cells.Locked = False
Next i
Application.ScreenUpdating = True


ActiveSheet.Protect Password:="PASSWORD", AllowFormattingRows:=True
End Sub

^^ This same macro lives in 14 sheets, and again, only the ar Array is different

And then in the 15th sheet I have the following macro assigned to a button:


Option Explicit
Sub RunAllFixMerged()
Call Sheet13.FixMerged
Call Sheet14.FixMerged
...
... (and so on 12 more times)
End Sub

So for example, if I am in Sheet13 and run macro FixMerged() it works properly, or if I run RunAllFixMerged, it works properly. But If I run the macro RunAllFixMerged from any sheet other than the one I'm in, it'll adjust all the row heights to 40.

Any input would be appreciated!! I'm really stuck here!

[Paul_Hossler]

Maybe instead of 15 almost identical macros each for one sheet, a single macro that handles 15 sheets would be easier

Not tested, but might be a start




Option Explicit

Sub test()
Dim iSheet As Long
Dim ar_array As Variant
Dim ws_array As Variant

ws_array = Array("Sheet1", "Sheet2", "Sheet3")

ReDim ar_array(LBound(ws_array) To UBound(ws_array))

ar_array(0) = Array("B8", "B13", "B16", "B20", "B24", "B28", "B30", "B35", "B36", "B41", "B45") 'Sheet1
ar_array(1) = Array("B18", "B413", "B16", "B20", "B24", "B28", "B30", "B35", "B36", "B41", "B45") 'Sheet2
ar_array(2) = Array("B28", "B313", "B16", "B20", "B24", "B28", "B30", "B35", "B36", "B41", "B45") 'Sheet3

Application.ScreenUpdating = False

For iSheet = LBound(ws_array) To UBound(ws_array)
Call FixMerged(ActiveWorkbook.Worksheets(ws_array(iSheet)), ar_array(iSheet))
Next iSheet

Application.ScreenUpdating = False
End Sub

Sub FixMerged(ws As Worksheet, ar As Variant)
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim i As Integer


ws.Unprotect Password:="PASSWORD"

For i = LBound(ar) To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
rng.MergeCells = False
cw = rng.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
rng.Cells(1).ColumnWidth = mw
rng.EntireRow.AutoFit
rwht = rng.RowHeight
rng.Cells(1).ColumnWidth = cw
rng.MergeCells = True
rng.RowHeight = rwht
If rng.RowHeight < 40 Then
rng.RowHeight = 40
Else
rng.RowHeight = rwht
End If
rng.Cells.Locked = False
Next I


ws.Protect Password:="PASSWORD", AllowFormattingRows:=True
End Sub

[Paul_Hossler]

Also just noticed ...

Rng. .... without a worksheet reference defaults to the Activesheet




ws.Select ' <<<<<<<<<<<<<<<
ws.Unprotect Password:="PASSWORD"


so you might add the .Select line to make the ws active, or change the rest to not assume the activesheet

[SamT]

With Paul's

Set rng = ws.Range(Range(ar(i)).MergeArea.Address)
And second "Application.ScreenUpdating" should be "True"