(Solved) – Excel VBA routine to wrap text and set row height

  • by

I have built a spreadsheet that at times requires to view “Notes” field so that all the text is visible, and sometimes so that all rows are the same height (15 works well). I wrote a routine called through click of a button and it works, but is slow (takes a few seconds for a table with 200 entries and could become longer if we have a couple of thousand records). I wonder if there was a better way to set row height. I base it on condition – if cell text is longer than 60 char, then wrap text and set row height. If less than 61 – set row height to 15.

Sub wrapText()

Dim targetRange As Range
Dim targetCell As Range
Dim w As Worksheet
Dim lastRow As Long

' avoid screen flicker

With Application
   .DisplayAlerts = False
   .ScreenUpdating = False

Set w = ActiveSheet
lastRow = w.UsedRange.Rows.Count

'Wrap cell text

Set targetRange = Range("G3:G" & lastRow)
For Each targetCell In targetRange.Cells
    If Not IsEmpty(targetCell.Value) Then
        If Len(targetCell.Value) > 60 Then
            targetCell.wrapText = True
        Else: targetCell.RowHeight = 15
        End If
    End If
Next targetCell

' This checks value of "O1" - I store 1 there if a custom filter is on

If Sheet1.Range("O1").Value = 0 Then  
    ActiveSheet.ListObjects("tblPatients").Range.AutoFilter Field:=6  
End If  
If Sheet1.Range("O1").Value = 1 Then
     ActiveSheet.ListObjects("tblPatients").Range.AutoFilter Field:=6, Criteria1:="="
End If

'restore normal XL settings for application

    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

I wonder if there is something obvious how I could achieve the same but in a more efficient way? Thanks.

Leave a Reply

Your email address will not be published. Required fields are marked *