Adding Rows to Maximize Page Display

[Ark68]

I hope I can explain this effectively ...

My application populates a form with rows dynamic data. The rows have a defined uniform height of 12.75. The form has two distinct sections. The two sections combined must fit on only one page.

To do this, I need to add "x" number of blank rows to each section to expand each section to the maximum needed to fill the whole page.

In an ideal world, the second section must contain 10 rows of combined data and blank rows, and the upper section, section one, must contain a combined 33 rows of data and blank rows.

The code provided below works fine if I maintain the proper row heights ... however ... I have some code that sets autofit row heights to accomodate word wrapped cells. The number of instances this happens is dynamic.

So, now with an undetermined number of rows heightened beyond the standard 12.75 ... my theory of simply adding rows to top of the sections doesn't work.

   For g = 0 To UBound(arr)
    Dim bmk, fnlrow, fmacnt, add_rows, fma_rows, pi1, pi2 As Integer
    Dim st, fma_rng, pda_rng As Range
        rptval = arr(g)
               
        With Sheets(arr(g))
            .Activate
            With .Rows("1:300")
                .RowHeight = 12.75
                '.VerticalAlignment = xlCenter
            End With
            
            Set pi1 = .Cells(.Rows.Count, "R").End(xlUp)
            pi2 = pi1.Row
            For Each Cell In ActiveSheet.Range("R13:R" & pi2)
                On Error Resume Next
                If Cell.Value = "DTR" Then
                    ad1 = Cell.Address
                    rw1 = Range(ad1).Row
                    .Range("A" & rw1).Rows.AutoFit
                End If
            Next Cell
            
            .Rows(3).RowHeight = 7.5
            .Rows(7).RowHeight = 9.75
            .Rows(8).RowHeight = 17.25
            .Rows(11).RowHeight = 6
            .Range("H12:Q12").ClearContents
            
            'section 2 (lower) minimum 10 rows

            bmk = Application.Match("Facility Maintenance Activities", .Range("A:A"))
            .Rows(bmk).RowHeight = 17.25
            .Rows(bmk - 1).RowHeight = 6.75
            .Rows(bmk + 1).RowHeight = 6.75
            
            fnlrow = Application.Match("Please use reverse for comments.", .Range("A:A"))
            Set fma_rng = .Range("C" & bmk + 3 & ":C" & fnlrow - 2)
            fmacnt = Application.CountA(fma_rng)
            If fmacnt = 0 Then
                .Rows(bmk + 4).Resize(10).EntireRow.Insert
            ElseIf fmacnt < 10 Then
                fma_rows = 10 - fmacnt
                Set st = fma_rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
                st.Offset(1).Resize(fma_rows).EntireRow.Insert
            Else
                Set st = fma_rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
                st.Offset(1).Resize(3).EntireRow.Insert
            End If

Add rows to section 1 (upper)

Dim area2, del_rows, fma_top, fma_btm, hmrows, rows_occ As Integer
            Dim rows_blnk As Double
            Dim rng_blank As Integer
            
            
            Set pda_rng = .Range("A12:A" & bmk - 2)
            Set st = pda_rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
            fnlrow = Application.Match("Please use reverse for comments.", .Range("A:A")) + 1
            add_rows = 52 - fnlrow
            
            area2 = .Range("A13:Q" & bmk - 3).Count
            rng_blank = Application.CountBlank(.Range("A13:Q" & bmk - 3))
            If add_rows < 0 Then
                
                'MsgBox "Page too big"
                del_rows = add_rows * -1
                ' can the deficit be accomodated in FMA?
                fma_top = Application.Match("Facility Maintenance Activities", .Range("A:A")) + 3
                fma_btm = Application.Match("Please use reverse for comments.", .Range("A:A")) - 2
                hmrows = fma_btm - fma_top + 1
                Set fma_rng = .Range("C" & fma_top & ":C" & fma_btm)
                rows_blnk = Application.CountBlank(fma_rng)
                If rows_blnk = hmrows Then
                    MsgBox "All rows are empty"
                    For i = fma_btm - 1 To fma_btm - del_rows Step -1
                        Rows(i).EntireRow.Delete
                    Next i
                Else
                    rows_occ = hmrows - rows_blnk
                    MsgBox rows_occ & " rows occupied" & Chr(13) & rows_blnk & " rows empty.)"
                    If del_rows < rows_blnk Then
                        For i = fma_btm - 1 To fma_btm - del_rows Step -1
                            Rows(i).EntireRow.Delete
                        Next i
                    Else
                        'insert page break
                        .HPageBreaks.Add Before:=Rows(fma_top - 3)
                                     
                    End If
                End If
               
            ElseIf add_rows = 0 Then
                MsgBox "No empty line addition required."
            
            Else
                If area2 <> rng_blank Then
                
                    st.Offset(1).Resize(add_rows).EntireRow.Insert
                    bmk = Application.Match("Facility Maintenance Activities", .Range("A:A"))
                    With .Range("A" & bmk - 3 & ":Q" & bmk - 2 - add_rows)
                        .Borders(xlInsideHorizontal).Weight = xlHairline
                        .Interior.ColorIndex = xlColorIndexNone
                    End With
                Else
                    'With .Range("A13:Q" & bmk - 3)
                    '    .Range("B13").Copy
                    '    .Paste
                    'End With
                End If
            End If

I admit ... not very pretty looking, but id "did" work.

Would anyone be able to help me find a more reliable and efficient way of pulling this off?

 

[ukmikeb]

Jenn

Just a suggestion.
You know how many rows you have on the page.
If you total the row height of the existing rows you can compare that with the absolute height of a normal section 1 (say 33 lines at 12.75).
Then compute the number of 12.75 rows to be added and a balancing row of row height <>12.75.
Remove blanks rows from section 2, if required.

hth

 

[Ark68]

Hi Mike ...

Suggestions are always welcome!! This one certianly makes sense, so I'll plug away at it. I'll report back with my success. No doubt there will be hurdles .. watch for them

Jenn