[RESOLVED] Problem Comparing Range Values

Thanks to your help here at the VB forum I have almost created an excellent accounting tool; unfortunately there are still flaws. Below is the code that I have been working on. For every cell in range “RA” it adds combinations of two cells in Range “RB” until it finds the two that equal the cell in range “RA.” So far it has been about 60% successful at finding all of the combinations of two cells in range “RB” whose sum equals the cells in “RA;” but for reasons unknown to me it does not find all of them. Can someone help me figure out why it misses some and what I can do about it?

VB Code:

Range("e1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RB"
    
    Range("f1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RA"
    
    Dim RangeA As Range
    Dim RangeB As Range
    Dim CellA As Range
    Dim CellB As Range
    Dim CellC As Range
    Set RangeA = Range("RA")
    Set RangeB = Range("RB")
    For Each CellA In RangeA.Cells
        For Each CellB In RangeB.Cells
            For Each CellC In RangeB.Cells
                If CellB + CellC = CellA Then
                    CellA.ClearContents
                    CellB.ClearContents
                    CellC.ClearContents
                 End If
            Next CellC
        Next CellB
    Next CellA

It looks as though you are clearing cells after they have been "found". This could lead to some problems. For example, if one of the cells in range B is equal to one in range A, then that cell plus a "zero" cell from range C will cause a match and hence cause the cell in range B to be eliminated. Thus its partner doesn't get "found".

For example:

Range A: 10, 20, 30
Range B: 4, 20, 18
Range C: 2, 6, 10

First run though: Finds 4+6 = 10
Second run: Finds 20 + 0 = 20
Third run: No more solutions, left with 30 in range A, 18 in Range B and 2 in Range C

You could try adding them to a list as you go and stepping through, so that you can see exaclty which ones are being found and which aren't.

HTH

zaza

Thank you for your quick reply; perhaps I should have put more of an explanation in my first entry. I have tried three different ways of marking the used cells; I have tried marking them by clearing them, which now thanks to you I understand why that was not working. I also tried marking them by adding a symbol to the values, but this would through it into debug mode, because the symbol was not a number. Recently I have tried replacing the numbers with another unusual number, but it still misses several that should have been marked. If it is in fact a result of how I change the cell value, do you have a suggestion for marking the cells so that they are not used twice? Also, I cannot seem to find a pattern for the ones that it finds and misses.

How about color coding the cells as you match them?

VB Code:

Sub Bots_problem()
Dim RangeA As Range
Dim RangeB As Range
Dim CellA As Range
Dim CellB As Range
Dim CellC As Range
    
    Range("e1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RB"
    
    Range("f1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RA"
    
    Set RangeA = Range("RA")
    Set RangeB = Range("RB")
    
    'Clear all colour from both ranges
    RangeB.Interior.ColorIndex = xlColorIndexNone
    RangeA.Interior.ColorIndex = xlColorIndexNone
    
    For Each CellA In RangeA.Cells
        For Each CellB In RangeB.Cells
            If CellB.Interior.ColorIndex <> 3 Then 'Only look for cells that haven't been color coded
                For Each CellC In RangeB.Cells
                    If CellC.Interior.ColorIndex <> 3 Then 'Only look for cells that haven't been color coded
                        If CellB + CellC = CellA _
                        And CellB.Row <> CellC.Row Then 'Ensures that your not using the same cell
                            CellA.Interior.ColorIndex = 3 'Mark cell as matched
                            CellB.Interior.ColorIndex = 3 'Mark cell as matched
                            CellC.Interior.ColorIndex = 3 'Mark cell as matched
                         End If
                     End If
                Next CellC
            End If
        Next CellB
    Next CellA
    
    
Set RangeA = Nothing
Set RangeB = Nothing
End Sub

I've also added a clause to your final if statement to ensure that you don't "double count" a cell -

VB Code:

And CellB.Row <> CellC.Row Then

This prevents the case where the value in a cell in RangeB is half the value of a cell in RangeA being treated as two seperate values....

Thanks again but it still missing some combinations, how do I attach an image?

OK, an image should be attached showing what happens after I run the below macro. I sum up one column and then switch it to the other; the results are red and blue, the yellow is what it missed, any suggestions?

VB Code:

Sub Macro1()
 
    Dim RangeA As Range
    Dim RangeB As Range
    Dim CellA As Range
    Dim CellB As Range
    Dim CellC As Range
    
    Range("e1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RB"
    
    Range("f1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "RA"
    
    Set RangeA = Range("RA")
    Set RangeB = Range("RB")
    
    'Clear all colour from both ranges
    RangeB.Interior.ColorIndex = xlColorIndexNone
    RangeA.Interior.ColorIndex = xlColorIndexNone
    
    For Each CellA In RangeA.Cells
        For Each CellB In RangeB.Cells
            If CellB.Interior.ColorIndex <> 3 Then 'Only look for cells that haven't been color coded
                For Each CellC In RangeB.Cells
                    If CellC.Interior.ColorIndex <> 3 Then 'Only look for cells that haven't been color coded
                        If CellB + CellC = CellA _
                        And CellB.Row <> CellC.Row Then 'Ensures that your not using the same cell
                            CellA.Interior.ColorIndex = 3 'Mark cell as matched
                            CellB.Interior.ColorIndex = 3 'Mark cell as matched
                            CellC.Interior.ColorIndex = 3 'Mark cell as matched
                         End If
                     End If
                Next CellC
            End If
        Next CellB
    Next CellA
    
'Set RangeA = Nothing
'Set RangeB = Nothing
 
'Set RangeA = Range("RA")
'Set RangeB = Range("RB")
    
    'Clear all colour from both ranges
    'RangeB.Interior.ColorIndex = xlColorIndexNone
    'RangeA.Interior.ColorIndex = xlColorIndexNone
    
    For Each CellA In RangeB.Cells
        For Each CellB In RangeA.Cells
            If CellB.Interior.ColorIndex <> 41 Then 'Only look for cells that haven't been color coded
                For Each CellC In RangeA.Cells
                    If CellC.Interior.ColorIndex <> 41 Then 'Only look for cells that haven't been color coded
                        If CellB + CellC = CellA _
                        And CellB.Row <> CellC.Row Then 'Ensures that your not using the same cell
                            CellA.Interior.ColorIndex = 41 'Mark cell as matched
                            CellB.Interior.ColorIndex = 41 'Mark cell as matched
                            CellC.Interior.ColorIndex = 41 'Mark cell as matched
                         End If
                     End If
                Next CellC
            End If
        Next CellB
    Next CellA
End Sub

Are these true 2 decimal places or do they have trailing decimals?

you count try replacing "CellB + CellC = CellA" with "round(CellB,2) + round(CellC,2) = round(CellA,2)"

Although your idea works when there are trailing numbers; apparently these columns do not have any.

Hm, that may not be enough. You could try putting a break in or an extra line of code to trap it during the second loop and monitor the values of CellB and CellC as the code runs.
If there is a number problem, you could stick in an extra line of code to multiple the number by 100, get rid of the remaining decimals (Int or Fix) and then divide by 100 again.

Worth a shot?


zaza

Thank you for your idea I am relatively new to vb so could you please give me an example of how and when I would multiply the value by a hundred and then how and when I would revert it by dividing by a hundred.

In the line

VB Code:

If CellB + CellC = CellA_

put

VB Code:

If (Fix(100*CellB)/100) + (Fix(100*CellC)/100)= (Fix(100*CellA)/100) _

HTH

zaza

Unfortunately that did not work, it continues to look like the example that I attached above. It must be an order thing; do you know of a way to reverse the order in which vb checks each cell?

This is a very strange thing, I typed in the numbers in a new workbook, mixed up the numbers in each column and then ran the macro. Even though they are all in a different order and in a new workbook it still found and missed the same ones. However I may just be losing my mind. The yellow cells are the cells that it keeps missing, or perhaps vb is adding them wrong.

Hi,

I tried your code and your initial columns and found exactly the same results as you. By stepping through and checking the values, it transpires that it is indeed a decimal point problem - every so often it returns the sum of CellB + CellC as 1*10^-13 different from CellA, and hence doesn't get a match.
Use the following:

Instead of

VB Code:

If CellB + CellC = CellA_

use

VB Code:

If Abs(CellA - (CellB + CellC)) < (1 / 10000000000)_

i.e., if the absolute value of the difference between the sum and CellA is less than a small number, assume it is OK.

HTH

zaza

You are a frickin genius!!!

How were you able to step through and discover that?

Well, many have said....

What I did was to put a breakpoint on the line

VB Code:

For Each CellA In RangeB.Cells

in the second loop and hover over CellA. Pressed F5 until it read 807.68, so that I knew it was the right value. Then put a breakpoint on the line

VB Code:

If CellB + CellC = CellA _

Hovered over CellB until it read 789.84. Then hovered over CellC and stepped through using F8 until it read 17.84. This should have been accepted. It wasn't. Inserted a line at the debug point reading:

VB Code:

f=CellA - (CellB + CellC)

and hovered over f. Found it to be small but non-zero. Concluded that this was the problem and hence it was obvious what needed to be done.

Glad it works,

zaza