Developers Depot

Sub Main()
       FormatRows “SubTotal”, Range(”A1:A200″), “A”, “G”

End Sub

Sub FormatRows(FindWhat As String, SearchRange As Range, formatColStart As String, formatColEnd As String)
    Dim OriginalSelectedRange As Range
    Dim firstFoundCell As Range
    Dim curFoundCell As Range
    Dim foundCell As Variant

On Error GoTo FormatRows_Error

    ‘Remeber what was selected
    Set OriginalSelectedRange = Selection
    ‘prevent user from watching the screen update
    Application.ScreenUpdating = False

    ’select range to search
    SearchRange.Select
       With Selection
        ‘try to find value
        Set foundCell = .Find(FindWhat, LookIn:=xlValues)
        ‘if a value was found in that selected range
        If Not foundCell Is Nothing Then
            ‘remember first found cell
            Set firstFoundCell = Range(foundCell.Address)
                Do
                ‘format
                Range((formatColStart & foundCell.Row) & “:” & (formatColEnd & foundCell.Row)).Font.Bold = True
                Range((formatColStart & foundCell.Row) & “:” & (formatColEnd & foundCell.Row)).Interior.ColorIndex = 3
                ‘try to find again
                Set foundCell = .FindNext(foundCell)
                ‘if a value was found in selected range AND its not the first found Cell
                If Not foundCell Is Nothing And foundCell.Address <> firstFoundCell.Address Then
                    Set curFoundCell = Range(foundCell.Address)
                Else
                     Exit Do
                End If
              Loop
      End If
      End With
    ‘Select the original range
    OriginalSelectedRange.Select
    ‘Restore Default
    Application.ScreenUpdating = True

On Error GoTo 0
   Exit Sub

FormatRows_Error:
    ‘Restore Default
    Application.ScreenUpdating = True
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure FormatRows”
End Sub

Sub main()

    RemoveSubtotals range(”1:900″)

End Sub

Sub RemoveSubtotals(rng As range)

On Errror GoTo oops
    With rng
        .Font.Bold = False
        .RemoveSubtotal
    End With
oops:
    On Error GoTo 0

End Sub