Adjust height of row(s) using VBA

[Livin404]

I'm trying to adjust the height of row so a paragraph will fit, otherwise after I run my numerous macros I have to manuals drag the row to see the whole paragraph. I'm pretty sure I didn't miss anything. I'm not getting any errors. The sheet is "Deficiencies", but I don't think that should matter.

Any assistance would be great.

Sub CAT_finishing()

Dim myRng As Range
Dim CAT1 As Range
Dim CAT2 As Range
Dim CAT3 As Range
Dim CAT4 As Range
Dim CAT5 As Range
Dim CAT6 As Range
Dim expDate As Range

Set myRng = ActiveSheet.Range("A1:I100")

Set CAT1 = myRng.Find(What:="*Pri A (CAT I)*", MatchCase:=True)
Set CAT2 = myRng.Find(What:="*Pri C (CAT II)*", MatchCase:=True)
Set CAT3 = myRng.Find(What:="*Pri D (CAT III)*", MatchCase:=True)
Set CAT4 = myRng.Find(What:="*Pri E (CAT IV)*", MatchCase:=True)
Set CAT5 = myRng.Find(What:="*Pri F (CAT V)*", MatchCase:=True)
Set CAT6 = myRng.Find(What:="*Pri R (CAT VI)*", MatchCase:=True)
Set expDate = myRng.Find(What:="*Adjust the expiration date*", MatchCase:=True)


If CAT1 Is Nothing Then Exit Sub
If CAT2 Is Nothing Then Exit Sub
If CAT3 Is Nothing Then Exit Sub
If CAT4 Is Nothing Then Exit Sub
If CAT5 Is Nothing Then Exit Sub
If CAT6 Is Nothing Then Exit Sub
If expDate Is Nothing Then Exit Sub

CAT1.EntireRow.RowHeight = 67.5
CAT2.RowHeight = 67
CAT3.RowHeight = 50
CAT4.RowHeight = 87
CAT5.RowHeight = 102.75
CAT6.RowHeight = 150
expDate.RowHeight = 50


End Sub

 

[rlv01]

What about something like this?

Sub CAT_finishing()
    
    Dim myRng As Range
    Dim CAT1 As Range
    Dim CAT2 As Range
    Dim CAT3 As Range
    Dim CAT4 As Range
    Dim CAT5 As Range
    Dim CAT6 As Range
    Dim expDate As Range
    
    Set myRng = ActiveSheet.Range("A1:I100")
    
    Set CAT1 = myRng.Find(What:="*Pri A (CAT I)*", MatchCase:=True)
    Set CAT2 = myRng.Find(What:="*Pri C (CAT II)*", MatchCase:=True)
    Set CAT3 = myRng.Find(What:="*Pri D (CAT III)*", MatchCase:=True)
    Set CAT4 = myRng.Find(What:="*Pri E (CAT IV)*", MatchCase:=True)
    Set CAT5 = myRng.Find(What:="*Pri F (CAT V)*", MatchCase:=True)
    Set CAT6 = myRng.Find(What:="*Pri R (CAT VI)*", MatchCase:=True)
    Set expDate = myRng.Find(What:="*Adjust the expiration date*", MatchCase:=True)
    
    
    If Not CAT1 Is Nothing Then CAT1.EntireRow.RowHeight = 67.5
    If Not CAT2 Is Nothing Then CAT2.RowHeight = 67
    If Not CAT3 Is Nothing Then CAT3.RowHeight = 50
    If Not CAT4 Is Nothing Then CAT4.RowHeight = 87
    If Not CAT5 Is Nothing Then CAT5.RowHeight = 102.75
    If Not CAT6 Is Nothing Then CAT6.RowHeight = 150
    If Not expDate Is Nothing Then expDate.RowHeight = 50
    
End Sub

Alternatively, you could try AutoFit:

Sub CAT_finishing2()
    
    Dim myRng As Range
    Dim CAT1 As Range
    Dim CAT2 As Range
    Dim CAT3 As Range
    Dim CAT4 As Range
    Dim CAT5 As Range
    Dim CAT6 As Range
    Dim expDate As Range
    
    Set myRng = ActiveSheet.Range("A1:I100")
    
    Set CAT1 = myRng.Find(What:="*Pri A (CAT I)*", MatchCase:=True)
    Set CAT2 = myRng.Find(What:="*Pri C (CAT II)*", MatchCase:=True)
    Set CAT3 = myRng.Find(What:="*Pri D (CAT III)*", MatchCase:=True)
    Set CAT4 = myRng.Find(What:="*Pri E (CAT IV)*", MatchCase:=True)
    Set CAT5 = myRng.Find(What:="*Pri F (CAT V)*", MatchCase:=True)
    Set CAT6 = myRng.Find(What:="*Pri R (CAT VI)*", MatchCase:=True)
    Set expDate = myRng.Find(What:="*Adjust the expiration date*", MatchCase:=True)
    
    myRng.Rows.AutoFit
End Sub