$35 USD: Macro to auto-fit merged cells and hide blank rows

  • I am looking for a macro that will do some formatting clean up to some tabs in a excel file used for annual review feedback. The tabs contain rows with merged cells (I realize that that these should be avoided but I inherited the file and trying to help out) and much of the data is copied and pasted into cells from other sources (word docs, e-mails, other excel files). During the annual review process there are over 100 of these files that are completed and administrators need to review and clean-up or fix any formatting issues so it looks good for printing purposes. I am looking for a macro that the admin can run to do the clean-up formatting that will accomplish the following 2 tasks on tabs '2014 Performance' and 'RA Development Feedback':

    1) Auto-Fit Row Height for rows with Merged Cells: One of the issues is that rows with merged cells do not auto-fit the row height. Some of the data that is being pasted into the rows with merged cells has more text in the cells than is visible due the row height not adjusting height. Admins manually adjust these rows to show all of the text in the rows and also reduce some row's height for rows with "extra space". Could a macro look for rows with merged cells in the 2 tabs and then auto-fit the row height?


    2) Hide Blank Rows based on Criteria: The other main issue is that there may be rows that have no data and I would like to have the macro to hide these rows. In column M, I have a formula that looks for rows that are blank and that should be "hidden" by the macro. So any cell in Col M that equals "Hide" should be hidden. Would like to add this to the macro as well.


    The attached file is a sample.


    Pre-payment has been sent. Thank you in advance for your help.

  • Re: $35 USD: Macro to auto-fit merged cells and hide blank rows


    Thank you Kris! I'll be offline until the morning. I will check the thread then to see if you had any luck with a solution. Let me know if you have any ?'s.


    Thank you again!

  • Re: $35 USD: Macro to auto-fit merged cells and hide blank rows


    Thanks Kris! Looks good but I have one question. For some reason row 26 (Total row) on 2014 Performance tab seems to getting hidden even though it doesn't have "Hide" in column M. Everything else seems to working OK. Would you be able to look at that?

  • Re: $35 USD: Macro to auto-fit merged cells and hide blank rows


    OK. Couple of changes in both the parameter procedures.


    Replace the two para procedures with the following.


    [vb]Private Sub MergedAreaRowAutofit(ByRef RangeToAdjust As Range)

    Dim r As Long
    Dim c As Long
    Dim i As Long
    Dim MW As Double 'merge width
    Dim RH As Double 'row height
    Dim MaxRH As Double
    Dim rngMArea As Range

    Const SpareCol As Long = 53 'BA

    With RangeToAdjust
    For r = 1 To .Rows.Count
    '//if the row is not hidden
    If Not .Parent.Rows(.Cells(r, 1).Row).Hidden Then
    '//if the cells have data
    If Application.WorksheetFunction.CountA(.Rows(r)) Then
    MaxRH = 0
    For c = .Columns.Count To 1 Step -1
    If Len(.Cells(r, c).Value) Then
    '//mergecells
    If .Cells(r, c).MergeCells Then
    Set rngMArea = .Cells(r, c).MergeArea
    With rngMArea
    MW = 0
    If .WrapText Then
    '//get the total width
    For i = 1 To .Cells.Count
    MW = MW + .Columns(i).ColumnWidth
    Next
    MW = MW + .Cells.Count * 0.66
    '//use the spare column and put the value, make autofit, get the row height
    With .Parent.Cells(.Row, SpareCol)
    .Value = rngMArea.Value
    .ColumnWidth = MW
    .WrapText = True
    .EntireRow.AutoFit
    RH = .RowHeight
    '//store the max row height for this row
    MaxRH = Application.Max(RH, MaxRH)
    .Value = vbNullString
    .WrapText = False
    .ColumnWidth = 8.43
    End With
    '//reset the row height
    .RowHeight = MaxRH
    End If
    End With
    ElseIf .Cells(r, c).WrapText Then
    '//get the current row height
    RH = .Cells(r, c).RowHeight
    .Cells(r, c).EntireRow.AutoFit
    '//if it's less than the original height, reset again
    If .Cells(r, c).RowHeight < RH Then .Cells(r, c).RowHeight = RH
    End If
    End If
    Next
    End If
    End If
    Next
    '''delete the spare column
    .Parent.Columns(SpareCol).Delete
    '//reset usedrange
    .Parent.Parent.Worksheets(.Parent.Name).UsedRange
    End With

    End Sub

    Private Sub HideBlankRows(ByRef RangeToHide As Range, ByVal Criteria As String)

    Dim rngFormulas As Range
    Dim rngArea As Range
    Dim i As Long

    On Error Resume Next
    RangeToHide.EntireRow.Hidden = False
    Set rngFormulas = RangeToHide.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If Not rngFormulas Is Nothing Then
    Criteria = UCase(Criteria)
    For Each rngArea In rngFormulas.Areas
    With rngArea
    For i = 1 To .Rows.Count
    If UCase(.Cells(i, 1).Value) = Criteria Then
    .Cells(i, 1).EntireRow.Hidden = True
    End If
    Next
    End With
    Next
    End If

    End Sub[/vb]