Finding all possible combinations of 2 sums

[togenmoser]

Hello everyone, I need some help here please.
Using vba macro, I want excel to find all possible combinations of 2 cells sum from each row of 5 cells that sum up to any of the target values of cells h1:r1.
And then set all-round thick border for all 2 cells that sum up to any of the target values.
And also set same border colour for cells that sum up to the same target value.
My worksheet has multiple rows and each row has 5 cells. Rows are separated by an empty cell.
I used the find sum pairs but excel keeps skipping some of the cells that has sum total equal to a target value.
Eg. Cells d33 and e33 has sum total of 83 but excel ignored it.
Any effort will be much appreciated.
Thanks.

DLF FORECAST.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y
1		82	63	55	14	69		145	137	96	151	118		77	132	69	124	83
2
3		26	75	41	64	83		48	51	37	71	21		63	4	70	75	25		72	41	84	52	25
4		54	53	29	60	56		39	87	32	53	51		30	20	1	56	72		75	41	28	9	37
5		29	6	34	90	21		47	82	37	16	42		26	19	44	61	4		43	75	90	11	64
6		72	64	6	19	50		4	69	43	44	8		22	12	27	18	89		30	36	17	8	64
7		40	37	69	7	60		20	10	73	44	12		41	74	43	31	82		36	28	90	87	56
8		12	88	65	63	70		59	85	71	52	90		35	11	36	24	42		69	14	12	35	16
9		31	66	44	18	4		54	26	19	37	75		80	76	11	85	66		63	79	51	47	53
10		90	85	62	10	49		84	69	79	18	68		55	77	19	79	70		69	65	15	24	26
11		72	12	80	5	85		58	81	25	60	83		81	3	49	10	86		70	53	85	30	43
12		35	16	45	19	17		47	64	6	25	60		83	87	6	23	68		81	41	90	65	45
13		20	15	18	38	59		21	69	16	37	33		79	70	90	41	40		65	66	63	38	68
14		64	77	81	66	37		51	61	36	55	13		6	57	63	68	16		31	20	1	61	42
15		72	77	80	37	61		56	85	73	68	39		39	54	25	75	60		20	36	49	88	30
16		1	14	37	86	90		68	88	66	57	26		73	72	23	56	63		58	29	26	76	89
17		15	87	40	70	83		79	44	38	42	30		89	4	3	25	82		34	33	68	50	82
18		65	76	78	57	22		67	52	68	41	27		61	12	25	14	90		34	18	58	55	21
19		19	27	84	41	22		22	32	4	30	15		81	47	87	38	52		29	4	5	6	18
20		59	23	72	6	25		52	31	64	34	79		56	59	9	21	46		68	50	45	28	15
21		71	54	20	24	75		15	70	17	77	16		42	43	41	70	68		29	63	26	33	17
22		53	4	78	15	10		37	86	33	35	11		29	62	70	49	41		25	14	84	10	51
23		17	31	70	67	75		26	86	12	39	13		6	30	34	50	19		17	10	78	50	7
24		50	55	74	58	81		25	89	19	46	37		17	35	12	80	63		32	7	51	17	80
25		17	8	67	31	12		16	17	62	76	58		79	90	13	54	32		7	32	1	70	43
26		37	90	57	85	9		15	40	45	89	82		72	49	90	5	37		74	80	68	13	10
27		62	26	67	33	59		82	73	13	52	51		44	66	60	82	69		56	60	54	41	45
28		49	80	43	15	5		51	20	15	16	32		31	12	56	37	68		59	18	12	28	61
29		48	63	75	88	41		32	87	57	71	80		43	36	80	57	35		88	1	52	43	61
30		75	70	46	55	26		59	2	42	34	54		9	43	23	8	64		63	54	51	80	48
31		56	21	82	76	16		64	26	54	41	57		4	68	46	55	7		82	46	68	8	11
32		78	31	13	1	14		56	57	59	14	12		35	45	89	39	78		38	29	27	33	19
33		85	82	15	68	70		20	61	65	63	82		65	11	72	25	27		79	37	36	34	73
SUN. SPECIAL

Cell Formulas
Range	Formula
H1	H1	=SUM(B1,C1)
I1	I1	=SUM(B1,D1)
J1	J1	=SUM(B1,E1)
K1	K1	=SUM(B1,F1)
L1	L1	=SUM(C1,D1)
N1	N1	=SUM(C1,E1)
O1	O1	=SUM(C1,F1)
P1	P1	=SUM(D1,E1)
Q1	Q1	=SUM(D1,F1)
R1	R1	=SUM(E1,F1)

Named Ranges
Name	Refers To	Cells
'SUN. SPECIAL'!Print_Area	='SUN. SPECIAL'!$C$1:$BC$106	N1:O1, L1, H1

 

[Kaper]

1) Make sure the values are there exactly as you see, not just formatted to show that way.
Have you checked?:

=D33+E33-R1=0

2) show us the code - may be it is a problem with code.

 

[togenmoser]

Here is the code I used. Cells h1:r1 are the target values.

Sub FindAllSumPairs()
'Declare variables
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim cell2 As Range
Dim i As Long, j As Long, k As Long, m As Long
Dim sum As Long
Dim color As Long

'Set worksheet and range
Set ws = ActiveSheet
Set rng = ws.UsedRange 'Change this as needed

'Loop through the target values in H1 to Q1
For i = 8 To 17
'Get the target value and a random color
sum = ws.Cells(1, i).Value
color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
'Check if the chosen color is too close to the previous color
If i > 7 Then
'Get the previous color
prevColor = ws.Cells(1, i - 1).Interior.color

'Calculate the difference between the two colors using Euclidean distance formula
diff = Sqr(((color Mod 256) - (prevColor Mod 256)) ^ 2 + ((color \ 256 Mod 256) - (prevColor \ 256 Mod 256)) ^ 2 + ((color \ 65536) - (prevColor \ 65536)) ^ 2)

'If the difference is less than a threshold, choose a different color
If diff < 50 Then 'Change this as needed
color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
End If

End If

'Loop through the rows in the range
For j = 1 To rng.Rows.Count
'Loop through the sets of 5 cells in the same row, separated by empty cells
For m = 1 To rng.Columns.Count Step 6
'Loop through the columns in the same set of 5 cells
For k = m To m + 4
'Loop through the remaining columns in the same set of 5 cells
For l = k + 1 To m + 4
'Check if the current cell and another cell are not empty and add up to the target value
If Not IsEmpty(rng.Cells(j, k)) And Not IsEmpty(rng.Cells(j, l)) And rng.Cells(j, k).Value + rng.Cells(j, l).Value = sum Then
'Set the border color and thickness for the pair of cells, using all round borders
With rng.Cells(j, k).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.color = color
.Weight = xlThick
End With

'Do not exit the inner loop to find all the pairs

End If

Next l

Next k

Next m

Next j

Next i

End Sub

 

[togenmoser]

I changed the code and it got worse. It wouldn't even do anything in the worksheet.
Here's the second code I tired ;


Sub FindMatchingCombinationsInRows()
Dim ws As Worksheet
Set ws = ActiveSheet

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim row As Long
Dim i As Integer, j As Integer, k As Integer
Dim sum As Double
Dim cellValue As Double
Dim combinationsRange As Range, compareRange As Range
Dim rng As Range

' Set the range for comparison (H1:R1)
Set compareRange = ws.Range("H1:R1")

' Loop through each row with data
For row = 1 To lastRow Step 2 ' Step 2 accounts for the empty row between data rows
' Set the range for the combinations (5 cells in the current row)
Set combinationsRange = ws.Range(ws.Cells(row, 1), ws.Cells(row, 5))

' Loop through each cell in the combinations range
For i = 1 To combinationsRange.Cells.Count
For j = i + 1 To combinationsRange.Cells.Count
' Calculate the sum of the two cells
sum = combinationsRange.Cells(i).Value + combinationsRange.Cells(j).Value

' Compare the sum with each cell in the compare range
For k = 1 To compareRange.Cells.Count
cellValue = compareRange.Cells(k).Value
' If a match is found, apply a thick border with a random color
If sum = cellValue Then
Set rng = Union(combinationsRange.Cells(i), combinationsRange.Cells(j))
' Apply a thick border with a random color to the matching combination
ApplyRandomColorBorder rng
' No need to exit the loop as we want to check all possible matches
End If
Next k
Next j
Next i
Next row
End Sub

Sub ApplyRandomColorBorder(rng As Range)
Dim border As Variant
For Each border In rng.Borders
With border
.LineStyle = xlContinuous
.ColorIndex = Int((56 - 1 + 1) * Rnd + 1) ' Random color index between 1 and 56
.Weight =
xlThick
End With
Next border
End Sub

 

[togenmoser]

1) Make sure the values are there exactly as you see, not just formatted to show that way.
Have you checked?:

=D33+E33-R1=0

2) show us the code - may be it is a problem with code.

I want excel to find all possible two cells in all rows that when sum up equals any of the cells h1:r1.

 

[Kaper]

as for this part:

=D33+E33-R1=0
I want excel to find all possible two cells in all rows that when sum up equals any of the cells h1:r1.

Sure, the code is for whole worksheet (had no time yet to read and analyze it). But you expected a specific sum in these particular cells, while it may be it only looks the proper way, and is not equal. Try writing in A1:A100 100 times 0.1 and then in B1 write

=100-sum(A1:A100)

one would expect 0 as a result and it is not! (because of problems with representation of decimal fractions in binary system and limited precision of calculations).

So did you try in your worksheet
=D33+E33-R1=0
?

 

[togenmoser]

W

as for this part:

Sure, the code is for whole worksheet (had no time yet to read and analyze it). But you expected a specific sum in these particular cells, while it may be it only looks the proper way, and is not equal. Try writing in A1:A100 100 times 0.1 and then in B1 write

=100-sum(A1:A100)

one would expect 0 as a result and it is not! (because of problems with representation of decimal fractions in binary system and limited precision of calculations).

So did you try in your worksheet
=D33+E33-R1=0
?

With the exception of cells in the 1 columns, the rest are populated data.
Cell B1:F1 contains current data. Whiles cells h1:r1 are the possible combinations of 2 cells of cells B1:F1.
Now I want excel to loop through the populated data in the rest of the worksheet and in all the rows to find all two cells in each row that sum up to any of r1:h1

 

[togenmoser]

W

With the exception of cells in the 1 columns, the rest are populated data.
Cell B1:F1 contains current data. Whiles cells h1:r1 are the possible combinations of 2 cells of cells B1:F1.
Now I want excel to loop through the populated data in the rest of the worksheet and in all the rows to find all two cells in each row that sum up to any of r1:h1

If the sun data of any two cells in the same row equals any of the cells in h1:r1, excel should set all round border colour to the two cells. Cells matching the same target value should have same all round border colour.
I've attached a screenshot of how it looks like the code is run.

 

[Kaper]

Before we start code fighting - have you tried my suggestion from post #6:

Did you try in your worksheet

=D33+E33-R1=0

It really could be the reason! But you left my question without answer.


Anyway, I went through the code and the real reason is (even commented in macro):

'Loop through the target values in H1 to Q1
For i = 8 To 17

While you mentioned in description (post #1):

the target values of cells h1:r1.

So this line(s) (change in the comment is optional, but highly recommended) shall read:

'Loop through the target values in H1 to R1
For i = 8 To 18

Have a good weekend!

 

[togenmoser]

Before we start code fighting - have you tried my suggestion from post #6:

Did you try in your worksheet

=D33+E33-R1=0

It really could be the reason! But you left my question without answer.


Anyway, I went through the code and the real reason is (even commented in macro):

'Loop through the target values in H1 to Q1
For i = 8 To 17

While you mentioned in description (post #1):


So this line(s) (change in the comment is optional, but highly recommended) shall read:

'Loop through the target values in H1 to R1
For i = 8 To 18

Have a good weekend!

Sorry sir, I tried your suggestion and the answer is 0 as you said.
Oh yeah!!! Thanks so much!!! I'll correct it and try it.
Thanks so much. You have no idea how helpful you've been to me.