uglyCode
uglyCode

Reputation: 1

Efficiently set the row height from autofit to static Excel/VBA

I am formatting a large number of row heights that contain varying numbers of merged cells by copying the range into an array and then pasting it to the right effectively unmerging the cells and using autofit to set the row height. Next I iterate through each row in the range setting Rows(i).RowHeight = Rows(i).RowHeight so I can clear the pasted data and keep the autofit row height as the static height. Is there a faster way to assign varying row heights across a range or make the existing autofit row height stay after clearing the cells? The code below takes about 10 to 15 seconds to run and the application settings don’t seem to make much of a difference.

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim i As Long
For i = 1 To 1000
    Rows(i).RowHeight = Rows(i).RowHeight
Next

Upvotes: 0

Views: 691

Answers (1)

Skin
Skin

Reputation: 11277

You could do something like this (it will need to be amended to suit your specific scenario AND you'll need to add the relevant code to speed it up as you've already got) ...

Public Sub RetainOriginalRowHeight()
    Dim lngRow As Long, arrRows() As Variant, objSheet As Worksheet
    
    Set objSheet = Sheet1
    
    With objSheet
        For lngRow = 1 To 1000
            ReDim Preserve arrRows(lngRow - 1)
            arrRows(lngRow - 1) = .Rows(lngRow).RowHeight
        Next
        
        objSheet.Cells.Clear
        
        For lngRow = 0 To UBound(arrRows)
            .Rows(lngRow + 1).RowHeight = arrRows(lngRow)
        Next
    End With
End Sub

... after you've pasted the data, go and get all of the row heights for the rows in question (I've just set it to 1000 like you did) and store them in an array.

Then after you clear the data (the middle line there) go back over each line and set the height to what it was before.

Something like that anyway.

Upvotes: 0

Related Questions