I'd love you if you could solve this macro challenge!

[Jenna]

I would love an idea of how to accomplish this problem.

I have 4 tables of numbers (in the same worksheet). I want
the user to select one number in each table and highlight
it or make it bold (or something similar). Then I want
the macro to add up the highlighted numbers and put the
answer in another cell. If the user changed one of the
highlights, the macro would change the sum.

This is simple to do manually but difficult to automate.
Any advice?

 

[hrlngrv - ExcelForums.com]

Jenna wrote..
..

I have 4 tables of numbers (in the same worksheet). I want th user t
select one number in each table and highlight it or make it bol (o
something similar). Then I want the macro to add up th highlighte
numbers and put the answer in another cell. If the user change one o
the highlights, the macro would change the sum

..

You'd have to use a udf to do this. Maybe something lik

Function fb(rng As Range, ftc As Range) As Varian
Dim i As Long, j As Long, m As Long, n As Lon
Dim rv As Varian

If rng.Areas.Count > 1 Then Set rng = rng.Areas(1

rv = rng.Areas(1).Valu

m = rng.Rows.Coun
n = rng.Columns.Coun

For i = 1 To
For j = 1 To
rv(i, j) =
If rng.Cells(i, j).Font.Background <> ftc.Font.Backgroun
Then
rv(i, j) =
If rng.Cells(i, j).Font.Bold <> ftc.Font.Bold Then rv(i
j) =
If rng.Cells(i, j).Font.Color <> ftc.Font.Color Then rv(i
j) =
If rng.Cells(i, j).Font.ColorIndex <> ftc.Font.ColorInde
Then
rv(i, j) =
If rng.Cells(i, j).Font.FontStyle <> ftc.Font.FontStyl
Then rv(i, j) =
If rng.Cells(i, j).Font.Italic <> ftc.Font.Italic The
rv(i, j) =
If rng.Cells(i, j).Font.Name <> ftc.Font.Name Then rv(i
j) =
If rng.Cells(i, j).Font.OutlineFont <
ftc.Font.OutlineFont Then
rv(i, j) =
If rng.Cells(i, j).Font.Shadow <> ftc.Font.Shadow The
rv(i, j) =
If rng.Cells(i, j).Font.Size <> ftc.Font.Size Then rv(i
j) =
If rng.Cells(i, j).Font.Strikethrough <
ftc.Font.Strikethrough Then
rv(i, j) =
If rng.Cells(i, j).Font.Subscript <> ftc.Font.Subscrip
Then rv(i, j) =
If rng.Cells(i, j).Font.Superscript <
ftc.Font.Superscript
Then rv(i, j) =
If rng.Cells(i, j).Font.Underline <> ftc.Font.Underlin
Then rv(i, j) =

If rng.Cells(i, j).Interior.Color <> ftc.Interior.Colo
Then rv(i, j) =
If rng.Cells(i, j).Interior.ColorIndex <
ftc.Interior.ColorIndex Then
rv(i, j) =
If rng.Cells(i, j).Interior.Pattern <
ftc.Interior.Pattern Then
rv(i, j) =
If rng.Cells(i, j).Interior.PatternColor <
ftc.Interior.PatternColor Then
rv(i, j) =
If rng.Cells(i, j).Interior.PatternColorIndex <
ftc.Interior.PatternColorIndex Then
rv(i, j) =
Next
Next

fb = r
End Functio

Use it in SUMPRODUCT formuas lik

=SUMPRODUCT(fb(B2:G17,IV65536),B2:G17

to sum the cells in B2:G17 that don't have the same formatting a
IV65536. You can add other properties to the udf above
Unfortunately, this has to be a brute force process

 

[The Wonder Thing]

I'm still fairly new to this stuff, but this is what I'd do:

Sub AddBold()
For Each c1 In ActiveSheet.Range("[Range of Table1]")
If c1.Font.Bold = True Then myOne = c1.Address([False], [False])
Next
For Each c2 In ActiveSheet.Range("[Range of Table2]")
If c2.Font.Bold = True Then myTwo = c2.Address([False], [False])
Next
For Each c3 In ActiveSheet.Range("[Range of Table3]")
If c3.Font.Bold = True Then myThree = c3.Address([False], [False])
Next
For Each c4 In ActiveSheet.Range("[Range of Table4]")
If c4.Font.Bold = True Then myFour = c4.Address([False], [False])
Next
ActiveSheet.Range([Answer Cell]).Formula = "=" & myOne & "+" & myTwo & "+" &
myThree & "+" & myFour
End Sub

Anything in square brackets should be replaced with what it indicates. ie.
[Range of Table 4] should become "A2:F56" if table 4 happens to cover every
cell from A2 to F56. Haven't tried it, only had 5 minutes, but it should work
I think.