VBA code to autofit rows

[pruleone]

Hi,

I tried to make a VBA code which would autofit all rows in worksheet.

I wrote this kind of code:
Private Sub Worksheet_Calculate()
If Range("A3") = 1 Then
Rows("3:3").Select
Selection.Rows.autofit
Range("A3").Select
End If
End Sub

In worksheet A3 = B1

Problem is, that this code doesn't work, it means that row doesn't change it size.

I have worksheet in different languages, and because of it expressions has different amount of letters, so if in english expression is only 5 letters long, than in other language it can be 10 or even more letters long.
I cant use shrink to fit command because then some of expressions could be so small that no one could see them.
So what I did, was that I changed all cells format to Wrap text. Now all text will be normal size but some times I need to change some of rows hight.

Of course I could to so, that all rows are always in maximum hight, but then sheet doesn't look so well.

So basically I need somekind of vba code, which would automaticly change all rows hights after I had choosed langugage.

How to do so?

 

[ClulessChris]

Autofit on a row will change row height, I think you may want columns.autofit

Never knock on Death's door: ring the bell and run away! Death really hates that!

 

[SkipVought]

and a code suggestion as well...

Private Sub Worksheet_Calculate()
   With Range("A3")
    If .Value = 1 Then
       .EntireRow.autofit
    End If
   end with
End Sub

or

Private Sub Worksheet_Calculate()
   With Range("A3")
    If .Value = 1 Then
       .EntireColumn.autofit
    End If
   end with
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[pruleone]

No I need to change row height.

I used your samples. So if I would like to change columns width, then your example did work very well.
But to force excel to change row height it doesn't work.

When I choose under Format menu Row and from there autofit, then row height will be changed.

I tried so and so, but nothing doesn't work.

 

[pruleone]

I found solution
Or to be true I found, what I did wrong

Thank you

 

[pruleone]

One more question with this issue.

It seems to me that right now this command works over and over again. What must I write to this command so it would work only one time?

Thank you.

 

[pruleone]

And once again I found solution

 

[SkipVought]

Tek-Tips is all about sharing information.

Several members have shared valuable information with you.

Would you please return the courtesy by sharing your solutions, rather than just stating that you found one.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[pruleone]

My mistake,

but my last code what did work was:

Private Sub Worksheet_Calculate()
If Range("s2").Value = "" Then
        Exit Sub
    End If
Application.ScreenUpdating = False
Application.EnableEvents = False
With Range("s7,s8,s9,s10,s19,s26,s33,s40,s353,s439")
If .Value = 2 Then
.EntireRow.AutoFit
End If
End With
With Range("s9,s19,s26,s33,s40,s98,s113,s128,s133,s138,s149,s154,s159,s164,s170,s224,s231,s239,s254,s259,s264,s275,s279,s284,s290,s296,s353,s388,s439,s474,s491,s509")
If .Value = 3 Then
.EntireRow.AutoFit
End If
End With
With Range("s7,s8,s9,s19,s26,s33,s40,s164,s290,s338,s353,s424,s439,s491,s509")
If .Value = 4 Then
.EntireRow.AutoFit
End If
End With
With Range("s8,s9,s10,s19,s26,s33,s40,s98,s105,s113,s128,s133,s138,s149,s154,s159,s164,s170,s217,s224,s231,s239,s254,s259,s264,s275,s279,s284,s290,s296,s338,s353,s366,s424,s439,s452,s491,S497,s509,S515")
If .Value = 5 Then
.EntireRow.AutoFit
End If
End With
With Range("s9,s10,s11,s19,s26,s33,s40,s338,s388,s424,s474,s491,s509")
If .Value = 6 Then
.EntireRow.AutoFit
End If
End With
    ActiveSheet.Outline.ShowLevels RowLevels:=5
    ActiveSheet.Outline.ShowLevels RowLevels:=4
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    ActiveSheet.Outline.ShowLevels RowLevels:=1
MsgBox ("Now You can fill tool!")
Application.ScreenUpdating = True
End Sub