Macro sum between all positive and negative entries to reach a value

hstef

New Member
Joined
Nov 19, 2018
Messages
39
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have a column (L) with some negative and positive entries (invoices value).
I have some customers who pay thru bank and does not specify which invoices is paying. And usually do not pay in order.
All i have is paymant's total value.

I need a macro to make calculation in column "L" until it reaches the total value of payment and to highlight the cells that made up the value.
I will put the payment value in "O1".

Column L example:
[TABLE="width: 90"]
<colgroup><col></colgroup><tbody>[TR]
[TD="align: right"]203.49[/TD]
[/TR]
[TR]
[TD="align: right"]224.91[/TD]
[/TR]
[TR]
[TD="align: right"]-224.91[/TD]
[/TR]
[TR]
[TD="align: right"]239.67[/TD]
[/TR]
[TR]
[TD="align: right"]-36.48[/TD]
[/TR]
[TR]
[TD="align: right"]-203.49[/TD]
[/TR]
[TR]
[TD="align: right"]64.26[/TD]
[/TR]
[TR]
[TD="align: right"]-66.96[/TD]
[/TR]
[TR]
[TD="align: right"]24.99[/TD]
[/TR]
[TR]
[TD="align: right"]-24.99[/TD]
[/TR]
[TR]
[TD="align: right"]105.43[/TD]
[/TR]
</tbody>[/TABLE]

Can this be done?
Thank you kindly,
Stef.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Hello,

Quite a common question ...

Are you trying to create an account reconciliation ...?
 
Upvote 0
Hi,

Not really. Just to find out what invoices are paid with a bank payment.

Thank you for your reply.
 
Upvote 0
Try this:-
Values summing to zero, coloured yellow.
Sum of remaining values in "O1".
Code:
[COLOR="Navy"]Sub[/COLOR] MG19Nov55
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n1          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n2          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
   
   [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("L2"), Range("L" & Rows.Count).End(xlUp))
     [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
         n1 = 0: n2 = 0
         [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Abs(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
                ReDim ray(1 To Rng.Count, 1 To 2)
                [COLOR="Navy"]If[/COLOR] Dn.Value > 0 [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] ray(1, 1) = Dn
                    n1 = n1 + 1
                [COLOR="Navy"]Else[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] ray(1, 2) = Dn
                    n2 = n2 + 1
                [COLOR="Navy"]End[/COLOR] If
                Dic.Add (Abs(Dn.Value)), Array(ray, n1, n2)
        [COLOR="Navy"]Else[/COLOR]
                Q = Dic(Abs(Dn.Value))
                    [COLOR="Navy"]If[/COLOR] Dn.Value > 0 [COLOR="Navy"]Then[/COLOR]
                        Q(1) = Q(1) + 1
                        [COLOR="Navy"]Set[/COLOR] Q(0)(Q(1), 1) = Dn
                    [COLOR="Navy"]Else[/COLOR]
                        Q(2) = Q(2) + 1
                        [COLOR="Navy"]Set[/COLOR] Q(0)(Q(2), 2) = Dn
                    [COLOR="Navy"]End[/COLOR] If
                Dic(Abs(Dn.Value)) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
 
   
   [COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
   [COLOR="Navy"]Dim[/COLOR] oSum [COLOR="Navy"]As[/COLOR] Double
   [COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
   
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
            [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Dic(k)(0), 1)
                [COLOR="Navy"]If[/COLOR] Dic(k)(0)(n, 1) <> "" [COLOR="Navy"]Then[/COLOR]
                   [COLOR="Navy"]If[/COLOR] Dic(k)(0)(n, 1) + Dic(k)(0)(n, 2) = 0 [COLOR="Navy"]Then[/COLOR]
                        Dic(k)(0)(n, 1).Interior.Color = vbYellow
                        Dic(k)(0)(n, 2).Interior.Color = vbYellow
                   [COLOR="Navy"]End[/COLOR] If
               [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] n
      
  [COLOR="Navy"]Next[/COLOR] k
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not Dn.Interior.Color = vbYellow [COLOR="Navy"]Then[/COLOR]
            oSum = oSum + Dn.Value
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
 Range("O1").Value = oSum

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi, sorry James, but this solution is not working. It freezes excel and no matter how long i wait it does not do anything. But thank you kindly for your suggestion.
 
Upvote 0
Hi MickG. Unfortunately your solution gave me different results. The highlighted cells does not represent the sum of the payment. But thank you kindly for your solution.
 
Upvote 0
If you could show a example of your data that fails, with the correct expected result in "O1". We could have another look.
 
Upvote 0
Hi,

I have a column (L) with some negative and positive entries (invoices value).
I have some customers who pay thru bank and does not specify which invoices is paying. And usually do not pay in order.
All i have is paymant's total value.

I need a macro to make calculation in column "L" until it reaches the total value of payment and to highlight the cells that made up the value.
I will put the payment value in "O1".

Using your example above, what should be the results?
 
Upvote 0
I'm not sure I follow the brief here. Looking at your sample I can see one-to-one matches but I cannot see how debits are met by a series of credits, or credits met by a series of debits. So assuming one-to-one match we can produce an analysis to identify all one-to-one matches so that you are left with a list of exceptions to attempt to match instead.

Excel 2010
[Table="width:, class:head"][tr=bgcolor:#888888][th]Row\Col[/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][th]
E
[/th][th]
F
[/th][th]
G
[/th][th]
H
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
1
[/td][td]Vals[/td][td]+ Count[/td][td]- Count[/td][td]Instance[/td][td]Match[/td][td][/td][td]check[/td][td]
=SUMIF(E:E,TRUE,A:A)
[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
2
[/td][td=bgcolor:#92D050]
203.49​
[/td][td]
=COUNTIF(A:A,ABS(A2))​
[/td][td]
=COUNTIF(A:A,-ABS(A2))​
[/td][td]
=COUNTIF($A$2:A2,A2)​
[/td][td]
=AND(D2<=B2,D2<=C2)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
3
[/td][td=bgcolor:#92D050]
224.91​
[/td][td]
=COUNTIF(A:A,ABS(A3))​
[/td][td]
=COUNTIF(A:A,-ABS(A3))​
[/td][td]
=COUNTIF($A$2:A3,A3)​
[/td][td]
=AND(D3<=B3,D3<=C3)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
4
[/td][td=bgcolor:#92D050]
(224.91)
[/td][td]
=COUNTIF(A:A,ABS(A4))​
[/td][td]
=COUNTIF(A:A,-ABS(A4))​
[/td][td]
=COUNTIF($A$2:A4,A4)​
[/td][td]
=AND(D4<=B4,D4<=C4)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
5
[/td][td]
239.67​
[/td][td]
=COUNTIF(A:A,ABS(A5))​
[/td][td]
=COUNTIF(A:A,-ABS(A5))​
[/td][td]
=COUNTIF($A$2:A5,A5)​
[/td][td]
=AND(D5<=B5,D5<=C5)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
6
[/td][td]
(36.48)
[/td][td]
=COUNTIF(A:A,ABS(A6))​
[/td][td]
=COUNTIF(A:A,-ABS(A6))​
[/td][td]
=COUNTIF($A$2:A6,A6)​
[/td][td]
=AND(D6<=B6,D6<=C6)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
7
[/td][td=bgcolor:#92D050]
(203.49)
[/td][td]
=COUNTIF(A:A,ABS(A7))​
[/td][td]
=COUNTIF(A:A,-ABS(A7))​
[/td][td]
=COUNTIF($A$2:A7,A7)​
[/td][td]
=AND(D7<=B7,D7<=C7)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
8
[/td][td]
64.26​
[/td][td]
=COUNTIF(A:A,ABS(A8))​
[/td][td]
=COUNTIF(A:A,-ABS(A8))​
[/td][td]
=COUNTIF($A$2:A8,A8)​
[/td][td]
=AND(D8<=B8,D8<=C8)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
9
[/td][td]
(66.96)
[/td][td]
=COUNTIF(A:A,ABS(A9))​
[/td][td]
=COUNTIF(A:A,-ABS(A9))​
[/td][td]
=COUNTIF($A$2:A9,A9)​
[/td][td]
=AND(D9<=B9,D9<=C9)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
10
[/td][td=bgcolor:#92D050]
24.99​
[/td][td]
=COUNTIF(A:A,ABS(A10))​
[/td][td]
=COUNTIF(A:A,-ABS(A10))​
[/td][td]
=COUNTIF($A$2:A10,A10)​
[/td][td]
=AND(D10<=B10,D10<=C10)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
11
[/td][td=bgcolor:#92D050]
(24.99)
[/td][td]
=COUNTIF(A:A,ABS(A11))​
[/td][td]
=COUNTIF(A:A,-ABS(A11))​
[/td][td]
=COUNTIF($A$2:A11,A11)​
[/td][td]
=AND(D11<=B11,D11<=C11)​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
12
[/td][td]
105.43​
[/td][td]
=COUNTIF(A:A,ABS(A12))​
[/td][td]
=COUNTIF(A:A,-ABS(A12))​
[/td][td]
=COUNTIF($A$2:A12,A12)​
[/td][td]
=AND(D12<=B12,D12<=C12)​
[/td][td][/td][td][/td][td][/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top