Announcement

Collapse
No announcement yet.

VBA Macro To Find Bold Cells In User Stated Range

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA Macro To Find Bold Cells In User Stated Range



    I need a function that does the following:

    1. Examines all of the cells in a user selected range to determine if any of the values in the range are bold.

    2. Where a bold cell is found (limit of one bold cell per row), its value is copied to a range (single column, multiple rows) specified by the user (by specifying the starting cell as an argument to the function)

    3. If multiple bold cells are found, the string "Multiple Values" copied to the appropriate cell in the range which would otherwise have contained the copied value

    The function with arguments might look like this:

    =BoldFinder (A1:H60,B11)

    I would be happy to pay someone $25 by whatever convenient means for some help on this very quickly.

  • #2
    Re: Function To Find Bold Cell Values

    A Function cannot make changes or Copy to other cells. It will have to be a macro procedure with ranges collected from the user via an InputBox.

    If you are OK with that, please attach a small BUT relevant before and after example file

    Comment


    • #3
      Re: Function To Find Bold Cell Values

      OK Here is a file that illustrates my need.

      If you can do this, I'd be thrilled.
      Attached Files

      Comment


      • #4
        Re: Function To Find Bold Cell Values

        Hi,

        I hope Dave won't mind for jumping in.

        Try this

        Sub test()
        Dim SourceRng As Range, DestCell As Range
        Dim Count As Long, i As Long, j As Long, n As Long, w(), temp
        On Error Resume Next
        Set SourceRng = Application.InputBox("Select the Range", "Source Range", Type:=8)
        Set DestCell = Application.InputBox("Select the Destination Cell", "Output Cell", Type:=8)
        On Error GoTo 0
        If Not SourceRng Is Nothing Then
        If Not DestCell Is Nothing Then
        ReDim w(1 To UBound(SourceRng.Value, 1), 1 To 1)
        With SourceRng
        For i = 1 To UBound(SourceRng.Value, 1)
        For j = 1 To .Columns.Count
        If ISBOLD(.Cells(i, j)) Then
        Count = Count + 1
        temp = .Cells(i, j).Value
        End If
        Next
        n = n + 1
        If Count = 1 Then
        w(n, 1) = temp
        ElseIf Count > 1 Then
        w(n, 1) = "Multiple Values"
        Else
        w(n, 1) = "No Values"
        End If
        Count = 0: temp = Empty
        Next
        End With
        With DestCell
        .Resize(n, 1).Value = w
        .Resize(n, 1).Font.Bold = True
        End With
        Else
        MsgBox "Not a valid cell", vbCritical
        Exit Sub
        End If
        Else
        MsgBox "Not a valid range", vbCritical
        Exit Sub
        End If
        End Sub
        Function ISBOLD(r As Range) As Boolean
        Dim i As Long
        ISBOLD = False
        With r
        For i = 1 To Len(r)
        If .Characters(i, 1).Font.Bold = True Then
        ISBOLD = True
        Exit For
        End If
        Next
        End With
        End Function


        HTH
        Kris

        ExcelFox

        Comment


        • #5
          Re: Function To Find Bold Cell Values

          Hey, kris. Nah, go for it, I'm going to be in and out all day Today.

          jshaver001, pay Kris,not me.

          Comment


          • #6
            Re: Function To Find Bold Cell Values

            Kris, how do I pay you?

            Comment


            • #7


              Re: Function To Find Bold Cell Values

              Hi,

              jshaver001,

              Got the payment.

              Thanks
              Kris

              ExcelFox

              Comment

              Working...
              X