I have a subroutine which re-formats cells after a heading is inserted into the document.
Most cells are 12.75 points high, whereas the headings are 15 points high.
When a heading (single line) is inserted, it pushes all of the other cells down, however the formatting does not move with them, so any headings below the inserted heading become 12.75 points high, while the cells above those headings become 15 points high.
Sub formatcell() Dim sht1 As Worksheet Set sht1 = ActiveSheet Dim startRow As Integer Dim endRow As Integer Dim counter As Integer Dim DoCell As Range Dim start As Variant Dim Finish As Variant startRow = 16 endRow = FindLastRow(sht1) 'THIS BIT BELOW NEEDS TO BE SPED UP' start = Timer 'Start Timer' counter = startRow Do While counter < endRow + 1 Set DoCell = sht1.Cells(counter, 1) Debug.Print "DoCell = " & DoCell.Address If DoCell.MergeArea.Count > 2 Then DoCell.RowHeight = 15 Else DoCell.RowHeight = 12.75 End If counter = counter + 1 Loop Finish = Timer 'End timer' MsgBox = "Time Taken = " & Finish - start End Sub
This uses the
Range.MergeArea.Count method (which identifies the headings as they are 26 cells wide), however I need to move through all of the cells below Row 15 to the end of the sheet and format them all. The problem is that it takes roughly 0.06 seconds per row. This sheet can easily have over 100 rows which need formatting, which is then 6sec I need to wait, which is frustrating.
Is there any other method to do this? Could I give the heading cell a range name (i.e.
Heading) when I insert it, and then lookup all cells with that range name?