Excel Formula to Lookup Values Based on Criteria

[Teal]

Hello,

I have found your site through the Access forum. Here is the link. Where I have posted the same problem. I need to lookup data from a list for instance: A2:A10 based on the value of B2. The value of B2 must be the sum total of the filtered values. In other words, the sum of the lookup data must be equal to the criteria in B2. Can you help me find an Excel formula for this?

Regards,
Teal

 

[eiloken]

try this, this code will loop through Filter Range and change all the cells color to yellow when sum of them match with critera:

Sub SumWithMatchCrit()
    Dim cll As Range
    Dim test As Range
    Dim trng As Range
    Dim rng As Range
    Dim crit As Integer
    Dim tVal As Integer
    Set rng = Range(Cells(2, 1), Cells(10, 1))
    rng.Interior.Pattern = xlNone
    crit = Cells(2, 2).Value
    For Each cll In rng
        Set trng = cll
        For Each test In rng
            If Intersect(test, trng) Is Nothing Then
                tVal = test.Value + WorksheetFunction.Sum(trng)
                If tVal = crit Then
                    Union(trng, test).Interior.Color = RGB(255, 255, 0)
                ElseIf tVal < crit Then
                    Set trng = Union(trng, test)
                End If
            End If
        Next test
    Next cll
End Sub

 

[eiloken]

try this, this code will loop through Filter Range and change all the cells color to yellow when sum of them match with critera:

Sub SumWithMatchCrit()
    Dim cll As Range
    Dim test As Range
    Dim trng As Range
    Dim rng As Range
    Dim crit As Integer
    Dim tVal As Integer
    Set rng = Range(Cells(2, 1), Cells(10, 1))
    rng.Interior.Pattern = xlNone
    crit = Cells(2, 2).Value
    For Each cll In rng
        Set trng = cll
        For Each test In rng
            If Intersect(test, trng) Is Nothing Then
                tVal = test.Value + WorksheetFunction.Sum(trng)
                If tVal = crit Then
                    Union(trng, test).Interior.Color = RGB(255, 255, 0)
                ElseIf tVal < crit Then
                    Set trng = Union(trng, test)
                End If
            End If
        Next test
    Next cll
End Sub

remember this will loop to find all values match with your condition so if in your range have multiple group of cells that have sum math with your criterial, all the cells will mark same as yellow color. In your example, i ran my code and it only have 3 cells match:

 

[BigBeachBananas]

How about this?

Sub FindCombinations()
    Dim Numbers() As Variant
    Dim TargetSum As Long
    Dim Combinations As Collection
    Dim Combination As Variant
    Dim i As Integer, j As Integer, k As Integer
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim CombinationDict As Object
  
    Set ws = ThisWorkbook.Sheets("Sheet1")
 
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ReDim Numbers(2 To lastRow)  '

    For i = 2 To lastRow
        Numbers(i) = ws.Cells(i, 1).value
    Next i
  
    TargetSum = ws.Range("B2").value
    Set Combinations = New Collection
    Set CombinationDict = CreateObject("Scripting.Dictionary")
  
    ' Loop through all possible combinations
    For i = 2 To 2 ^ lastRow - 1
        Dim CurrentCombination As String
        CurrentCombination = ""
        Dim CurrentSum As Long
        CurrentSum = 0
      
        For j = 2 To lastRow
            If (i And (2 ^ (j - 1))) <> 0 Then
                CurrentSum = CurrentSum + Numbers(j)
                CurrentCombination = CurrentCombination & Numbers(j) & ","
            End If
        Next j
     
        If CurrentSum = TargetSum Then
     
            If Not CombinationDict.Exists(CurrentCombination) Then
                Combinations.Add Left(CurrentCombination, Len(CurrentCombination) - 1) ' Remove the trailing comma
                ' Add the combination to the dictionary to mark it as seen
                CombinationDict(CurrentCombination) = 1
            End If
        End If
    Next i
  
    ' Display the valid combinations
    For Each Combination In Combinations
        Debug.Print Combination
    Next Combination
End Sub

 

[Teal]

try this, this code will loop through Filter Range and change all the cells color to yellow when sum of them match with critera:

Sub SumWithMatchCrit()
    Dim cll As Range
    Dim test As Range
    Dim trng As Range
    Dim rng As Range
    Dim crit As Integer
    Dim tVal As Integer
    Set rng = Range(Cells(2, 1), Cells(10, 1))
    rng.Interior.Pattern = xlNone
    crit = Cells(2, 2).Value
    For Each cll In rng
        Set trng = cll
        For Each test In rng
            If Intersect(test, trng) Is Nothing Then
                tVal = test.Value + WorksheetFunction.Sum(trng)
                If tVal = crit Then
                    Union(trng, test).Interior.Color = RGB(255, 255, 0)
                ElseIf tVal < crit Then
                    Set trng = Union(trng, test)
                End If
            End If
        Next test
    Next cll
End Sub

Yes, it worked perfectly in this case. Thank you so much!
I have one more question. What if my data has both integer and decimal values? I have changed the crit and tVal as Double. But it is not working. Do I have to modify anything else?

 

[eiloken]

Yes, it worked perfectly in this case. Thank you so much!
I have one more question. What if my data has both integer and decimal values? I have changed the crit and tVal as Double. But it is not working. Do I have to modify anything else?

give me your data, i change tVal and crit to double and it still work:

 

[Teal]

Yes, it worked perfectly in this case. Thank you so much!
I have one more question. What if my data has both integer and decimal values? I have changed the crit and tVal as Double. But it is not working. Do I have to modify anything else?

 

[Teal]

give me your data, i change tVal and crit to double and it still work:View attachment 99774

Mydata.xlsm
	A	B
1	Filter Range	Criteria
2	0.5	163594.7
3	0.01
4	932.2
5	326.03
6	1020.34
7	11584.82
8	341.74
9	559.08
10	217.36
11	14915.06
12	8182.04
13	233.05
14	4557.11
15	1521.45
16	108.68
17	4069.32
18	10017.45
19	667.77
20	5125.87
21	2501.25
22	3419.65
23	1025.18
24	574.78
25	559.09
26	12799.52
27	326.03
28	2777.25
29	12811.3
30	1259.25
31	7779.97
32	14505.77
33	4128.22
34	27144.71
35	7866
36	9257.92
37	3320.63
38	450.41
39	1956.16
40	5554.5
41	14025.1
42	2221.8
43	15558.69
44	4238.36
45	119.54
46	10449.75
47	543.38
48	1165.24
49	2777.25
50	14834.16
51	52442.01
52	10413.25
53	2.97
54	10042.4
55	33791.91
56	108.68
57	108.68
58	108.68
59	5739.26
60	233.05
61	19683.49
62	217.35
63	2282.18
64	5554.53
65	6461.36
66	108.68
67	12123.31
68	17919.39
69	5163.5
70	2608.2
71	217.35
72	4020.98
73	5005.98
74	3701.3
75	15032.11
76	5425.13
77	32890.07
78	5071.5
79	217.35
80	4347.04
81	9039
82	108.68
83	108.68
84	13584.39
85	108.68
86	3042.92
87	6749.97
88	11004.67
89	108.68
90	108.68
91	523.6
92	5808.08
93	16255.25
94	5110.17
95	760.73
96	1983.75
97	63150.72
98	2448.38
99	1992.38
100	3174
101	22495.71
102	326.03
103	760.73
104	5593.14
105	6292.3
106	2966.84
107	217.36
108	7670.51
109	19167.4
110	9357.28
111	2646.18
112	1412.78
113	108.68
114	434.7
115	1165.24
116	5977.15
117	4570.71
118	217.35
119	19722.17
120	5226.75
121	1328.26
122	7619.36
123	33315.99
124	14201.71
125	1964.72
126	10994.32
127	5735.64
128	13050.66
129	6725.8
130	3610.73
131	8538.25
132	1455.79
133	3260.28
134	22903.56
135	32480.94
136	9355.25
137	543.38
138	7084.42
139	326.03
140	5313.01
141	6525.33
142	9442.65
143	17635.53
144	396.75
145	4890.39
146	1398.29
147	4464.43
148	326.04
149	793.5
150	5977.14
151	10254.09
152	12280.3
153	869.41
154	6520.52
155	20275.13
156	2415
157	23141.79
158	14761.77
159	3875.5
160	10777.7
161	8633.64
162	3224.8
163	1329.4
164	8038.63
165	664.13
166	6878.17
167	108.68
168	326.03
169	108.68
170	543.38
171	8351.29
172	1190.25
173	15214.52
174	25571.69
175	233.05
176	108.68
177	35069.59
178	11511.5
179	47028.42
180	3523.33
181	1110.9
182	1412.78
183	5358.91
184	3471.57
185	108.68
186	2536.34
187	18576.61
188	25208.03
189	16894.46
190	22118.6
191	683.46
192	2825.56
193	108.68
194	9784.97
195	3541.46
196	8271.4
197	29110.57
198	68596.1
199	11669.42
200	15015.27
201	6365.25
202	4274.57
203	4815.52
204	21364.62
205	5433.75
206	3924.97
207	5899.87
208	15462.62
209	1630.14
210	22063.47
211	5353.44
212	396.75
213	2415
214	11664.46
215	5808.08
216	108.68
217	6059.24
218	4648.9
219	5649.38
220	17068.11
221	5807.5
222	9201.26
223	217.35
224	5925.96
225	12294.35
226	5119.81
227	108.68
228	18541.78
229	7305.39
230	10388.17
231	2990
Sheet1

 

[Teal]

How about this?

Sub FindCombinations()
    Dim Numbers() As Variant
    Dim TargetSum As Long
    Dim Combinations As Collection
    Dim Combination As Variant
    Dim i As Integer, j As Integer, k As Integer
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim CombinationDict As Object
 
    Set ws = ThisWorkbook.Sheets("Sheet1")
 
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ReDim Numbers(2 To lastRow)  '

    For i = 2 To lastRow
        Numbers(i) = ws.Cells(i, 1).value
    Next i
 
    TargetSum = ws.Range("B2").value
    Set Combinations = New Collection
    Set CombinationDict = CreateObject("Scripting.Dictionary")
 
    ' Loop through all possible combinations
    For i = 2 To 2 ^ lastRow - 1
        Dim CurrentCombination As String
        CurrentCombination = ""
        Dim CurrentSum As Long
        CurrentSum = 0
     
        For j = 2 To lastRow
            If (i And (2 ^ (j - 1))) <> 0 Then
                CurrentSum = CurrentSum + Numbers(j)
                CurrentCombination = CurrentCombination & Numbers(j) & ","
            End If
        Next j
    
        If CurrentSum = TargetSum Then
    
            If Not CombinationDict.Exists(CurrentCombination) Then
                Combinations.Add Left(CurrentCombination, Len(CurrentCombination) - 1) ' Remove the trailing comma
                ' Add the combination to the dictionary to mark it as seen
                CombinationDict(CurrentCombination) = 1
            End If
        End If
    Next i
 
    ' Display the valid combinations
    For Each Combination In Combinations
        Debug.Print Combination
    Next Combination
End Sub

Hello,

It is working for the example dataset perfectly too. But this code returns an overflow error for my large dataset (A2:A231). Any thoughts?

 

[eiloken]

Ok it happened because when vba calculate decimal number, it will compare exactly all the digits of decimal part so when you compare it with your criteria with round of decimal digits, it will not equals. So i think this will work:

Sub SumWithMatchCrit()
    Dim lr As Long
    Dim cll As Range
    Dim test As Range
    Dim trng As Range
    Dim rng As Range
    Dim crit As Double
    Dim tVal As Double
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("A2:A" & lr)
    rng.Interior.Pattern = xlNone
    crit = Cells(2, 2).Value
    For Each cll In rng
        Set trng = cll
        For Each test In rng
            If Intersect(test, trng) Is Nothing Then
                tVal = test.Value + WorksheetFunction.Sum(trng)
                If Round(tVal, 1) = Round(crit, 1) Then 'change the digit to what you need
                    Debug.Print Union(trng, test)
                    Union(trng, test).Interior.Color = RGB(255, 255, 0)
                ElseIf tVal < crit Then
                    Set trng = Union(trng, test)
                End If
            End If
        Next test
    Next cll
End Sub