VBA to set row height automatically where a cell value equals a certain value

[clothian]

Hi - I'm new to vba, but not new to excel. I'm after setting the row height automatically where a cell value equals a certain value.

I'm using a Named Range "Row_Type" which is located within a Table "Table1". The Named Range is located in Column C and this is the 2nd Column in "Table1".

Where the cell value within "Row_Type" is Empty or "Row Type 1", then set Row Height to 20
Where the cell value within "Row_Type" is "Row Type 2", then set Row Height to 15
Where the cell value within "Row_Type" is "Row Type 3" or "Row Type 4" or "Row Type 5" or "Row Type 6", then set Row Height to 10

I'm wanting this to be live / automatic too, so that as more rows are added to the range, or cells within the range change, row heights adjust as per the above rules. I thought I'd be able to modify some existing advice offered on here, but have failed.

This is what I've started with (might be miles off).....

Option Explicit

Sub Worksheet_Change(ByVal target As Range)
Dim MyRange As Range, MyVals As Variant, i As Long

    If Intersect(target, Range("Row_Type")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    MyVals = Range("Row_Type").Value
    For i = 4 To 126
        If (MyVals("Row_Type") = "Row Type 3" Or MyVals("Row_Type") = "Row Type 4" Or MyVals("Row_Type") = "Row Type 5" Or MyVals("Row_Type") = "Row Type 6") Then
            If MyRange Is Nothing Then
                Set MyRange = Range("Row_Type")
            Else
                Set MyRange = Union(MyRange, Range("Row_Type"))
            End If
        End If

    Next i
    MyRange.rowheight = 10
    Application.ScreenUpdating = True
    
End Sub

Any help would be much appreciated.

 

[clothian]

User selecting the value (Row Type 1, Row Type 2 etc. etc.), from list (data validation drop down).

Hi Fluff,

Any way of enabling this to work if the user is also copying and pasting numerous values into separate rows of the Row Type cells?
e.g.
Row Type 1
Row Type 1
Row Type 2
Row Type 3
Row Type 2
Row Type 1

(I guess this might have been why you asked this question)

 

[Fluff]

How about

Sub Worksheet_Change(ByVal Target As Range)
   Dim MyRange As Range, Cl As Range
   Dim Tbl As ListObject

   Set Tbl = Me.ListObjects("Table1")
   Set MyRange = Intersect(Target, Tbl.ListColumns(2).DataBodyRange)
   If Not MyRange Is Nothing Then
      For Each Cl In MyRange
         Select Case Cl.Value
            Case "", "Row Type 1"
               Cl.RowHeight = 20
            Case "Row Type 2"
               Cl.RowHeight = 15
            Case Else
               Cl.RowHeight = 10
         End Select
      Next Cl
   End If
End Sub

 

[clothian]

How about

Sub Worksheet_Change(ByVal Target As Range)
   Dim MyRange As Range, Cl As Range
   Dim Tbl As ListObject

   Set Tbl = Me.ListObjects("Table1")
   Set MyRange = Intersect(Target, Tbl.ListColumns(2).DataBodyRange)
   If Not MyRange Is Nothing Then
      For Each Cl In MyRange
         Select Case Cl.Value
            Case "", "Row Type 1"
               Cl.RowHeight = 20
            Case "Row Type 2"
               Cl.RowHeight = 15
            Case Else
               Cl.RowHeight = 10
         End Select
      Next Cl
   End If
End Sub

That works for the row height. I'd added some further formatting for the row, which is still working if manually input cell info into Row Type, but doesn't work if multiple values are copy & pasted into multiple rows.

The additional formatting that I'd added is:

For Each Cl In MyRange
         Select Case Cl.Value
            Case "", "Row Type 1"
                Cl.rowheight = 20
                Intersect(ActiveCell.EntireRow, ActiveSheet.ListObjects("Table1").DataBodyRange).Select
                With Selection
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlLeft
                    .IndentLevel = 0
                End With
                
                With Selection.Interior
                    .Color = 192
                End With
                With Selection.Font
                    .Bold = True
                    .Name = "Calibri"
                    .Size = 16
                    .ThemeColor = xlThemeColorDark1
                    .Underline = xlUnderlineStyleSingle
                End With
            
            Case "Row Type 2"
                Cl.rowheight = 12.5
                Intersect(ActiveCell.EntireRow, ActiveSheet.ListObjects("Table1").DataBodyRange).Select
                With Selection
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlLeft
                    .IndentLevel = 2
                End With
                With Selection.Interior
                    .Pattern = xlNone
                End With
                With Selection.Font
                    .Bold = True
                    .Name = "Calibri"
                    .Size = 10
                    .ColorIndex = xlAutomatic
                End With
               
            Case Else
                Cl.rowheight = 9.75
            End Select
      Next Cl

 

[Fluff]

Replace both ActiveCell & Selection with Cl

 

[clothian]

Replace both ActiveCell & Selection with Cl

Doing both didn't give what I was after, but leaving "Selection" in place achieved it:

For Each Cl In MyRange
         Select Case Cl.Value
            Case "", "Row Type 1"
                Cl.rowheight = 20
                Intersect(Cl.EntireRow, ActiveSheet.ListObjects("Table1").DataBodyRange).Select
                With Selection
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlLeft
                    .IndentLevel = 0
                End With
                
                With Selection.Interior
                    .Color = 192
                End With
                With Selection.Font
                    .Bold = True
                    .Name = "Calibri"
                    .Size = 16
                    .ThemeColor = xlThemeColorDark1
                    .Underline = xlUnderlineStyleSingle
                End With
            
            Case "Row Type 2"
                Cl.rowheight = 12.5
                Intersect(Cl.EntireRow, ActiveSheet.ListObjects("Table1").DataBodyRange).Select
                With Selection
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlLeft
                    .IndentLevel = 2
                End With
                With Selection.Interior
                    .Pattern = xlNone
                End With
                With Selection.Font
                    .Bold = True
                    .Name = "Calibri"
                    .Size = 10
                    .ColorIndex = xlAutomatic
                End With
               
            Case Else
                Cl.rowheight = 9.75
            End Select
      Next Cl

Thanks for all your help

 

[Fluff]

Glad you sorted it & thanks for the feedback.