Speeding up my macro by using cells that are non-blank rather than setting row numbers

[Milos]

Hi all,

I am just looking to speed up a section of one of my macros as it seems to be lagging and I perform this macro in a high stress period of my job so it would be great to speed things up. I have to perform this macro to about 20 worksheets every 2 weeks or so. Usually only 2 of the 20 sheets is actually filled with information 1000 rows down. Most often they are between 30 and 250.

Can somebody please tell me how I would refine my code to start searching and updating row heights from cell A7 downwards and getting the macro to stop performing once it reaches the first empty A cell. Currently I just set it at the maximum range to capture so that every sheet will work properly

The code is shown below:

Dim ws As Worksheet                         
Dim c As Range 


 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
    For Each ws In ActiveWindow.SelectedSheets
        For Each c In ws.Range("A7:A1000")
            c.EntireRow.AutoFit
            If c.RowHeight < 20 Then c.RowHeight = 20
        Next c
    Next ws
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

Any help is greatly appreciated.

Thanks,
Milos

 

[rlv01]

    Dim ws As Worksheet
    Dim c As Range
    Dim Rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each ws In ActiveWindow.SelectedSheets
        ws.Range("A7:A1000").EntireRow.AutoFit
        Set Rng = ws.Range("A7:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
        For Each c In Rng
            If c.RowHeight < 20 Then c.RowHeight = 20
        Next c
    Next ws
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

 

[Milos]

Thank you very much rlv01!

Works perfectly!

 

[rlv01]

You're welcome