VBA to Auto Resize Excel Row Heights

[MrMaker]

Afternoon all,

Hopefully a very quick one, I have some working code which (when run) auto resizes the row heights on 4 named sheets (Sheet1/2/3/4) to '45'.

Is there a way that I can resize sheet 4' to a different height to the others?

Thanks

Private Sub Workbook_Open()

Dim Ws As Worksheet

Dim Crit As String

Application.ScreenUpdating = False

Crit = Sheets("Selector").Range("A1").Value

For Each Ws In Worksheets

Select Case Ws.Name

Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"

Ws.UsedRange.AutoFilter 1, "<>" & Crit

Ws.AutoFilter.Range.Offset(1).EntireRow.Delete

Ws.AutoFilterMode = False

Ws.Range("A2:A" & ws.Rows.Count).RowHeight = 45

End Select

Next Ws

With Sheets("Selector")

.Range("A1").Value = Crit

.Rows.RowHeight = 45

.Visible = xlHidden

End With

End Sub

 

[Fluff]

Can you please report your code using the VBA code tags, rather than putting it in a table.

 

[MrMaker]

Apologies, how do I do this?

 

[Fluff]

You should not put the code in a table, just copy it from the VB Editor & paste it to the board between the code tags.
That way it makes it easier for any potential helper.

 

[Fluff]

To have sheet 4 use a different row height, you can just add another case to the select case statement for sheet4 & remove sheet4 from your existing case.

 

[MrMaker]

Ah ok, let's try this:
I inherited the code so I'm not too clear how I'd do that, any ideas?
Thanks in advance

Private Sub Workbook_Open()
   Dim Ws As Worksheet
   Dim Crit As String
   
   Application.ScreenUpdating = False
   Crit = Sheets("Selector").Range("A1").Value
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"
            Ws.UsedRange.AutoFilter 1, "<>" & Crit
            Ws.AutoFilter.Range.Offset(1).EntireRow.Delete
            Ws.AutoFilterMode = False
            Ws.Range("A2:A" & Ws.Rows.Count).RowHeight = 45
      End Select
   Next Ws
   With Sheets("Selector")
      .Range("A1").Value = Crit
      .Rows.RowHeight = 45
      .Visible = xlHidden
   End With
End Sub

 

[Fluff]

Thanks for that, it's a lot better.
How about

Private Sub Workbook_Open()
   Dim Ws As Worksheet
   Dim Crit As String
   
   Application.ScreenUpdating = False
   Crit = Sheets("Selector").Range("A1").Value
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Sheet1", "Sheet2", "Sheet3"
            Ws.UsedRange.AutoFilter 1, "<>" & Crit
            Ws.AutoFilter.Range.Offset(1).EntireRow.Delete
            Ws.AutoFilterMode = False
            Ws.Range("A2:A" & Ws.Rows.Count).RowHeight = 45
         Case "Sheet4"
            Ws.UsedRange.AutoFilter 1, "<>" & Crit
            Ws.AutoFilter.Range.Offset(1).EntireRow.Delete
            Ws.AutoFilterMode = False
            Ws.Range("A2:A" & Ws.Rows.Count).RowHeight = 20
      End Select
   Next Ws
   With Sheets("Selector")
      .Range("A1").Value = Crit
      .Rows.RowHeight = 45
      .Visible = xlHidden
   End With
End Sub

Just change the row height for sheet 4 from 20 to what ever it needs to be.

 

[MrMaker]

Works brilliantly, thank you very much!

I'll try and remember the code thing for next time ?

 

[Fluff]

You're welcome & thanks for the feedback.