Debit & Credit total value to be zero

P

prakash

New Member
Joined
May 5, 2005
Messages
36
Dear Sir,

There are a set of debit values and a set ot credit values in a column. I want a vba code by whcich the debit value plus a single / multiple credit value is zero that needs to be marked .

finally i will come to know out of the avaibale debits which cannot be used the with avilable credits either single or multiple values.

If multiple matching sets are available let it take the 1st or the 2nd one its not an issue.

Column A Ref

-1000 A
-5000 B
-8000 C




800 A
100 A
100 A
2000 B
3000 B
13000
15000

Thanks in Advance
R.Ramakrishnan
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Sort by date Sort by votes
If your Debit/Credits are in column "A" starting row (2) and your References are in column "B", starting row (2) then
In column "C" where there is a matching Debit with Single/Multi Credits the code will place a Number defining each new Match of Debit /Credit.
The same unique number will be in the same matching cells.

Code: 
[COLOR=navy]Sub[/COLOR] MG11Apr43
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Deb [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] Cred [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Del [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Dn.Offset(, -1) < 0 [COLOR=navy]Then[/COLOR]
        Deb = Dn.Offset(, -1)
       [COLOR=navy]ElseIf[/COLOR] Dn.Offset(, -1) > 0 [COLOR=navy]Then[/COLOR]
             Cred = Dn.Offset(, -1)
          [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
    .Add Dn.value, Array(Dn.Address, Deb, Cred, "")
[COLOR=navy]Else[/COLOR]
Q = .Item(Dn.value)
[COLOR=navy]If[/COLOR] Dn.Offset(, -1) > 0 [COLOR=navy]Then[/COLOR]
      Q(2) = Q(2) + Dn.Offset(, -1)
    [COLOR=navy]Else[/COLOR]
          Q(1) = Dn.Offset(, -1)
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Q(3) = "" [COLOR=navy]Then[/COLOR]
       Q(3) = Q(3) & Q(0) & "," & Dn.Address
    [COLOR=navy]Else[/COLOR]
           Q(3) = Q(3) & "," & Dn.Address
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Q(1) + Q(2) = 0 [COLOR=navy]Then[/COLOR]
        col = col + 1
         Ray = Split(Q(3), ",")
              [COLOR=navy]For[/COLOR] Del = 0 To UBound(Ray)
                   Range(Ray(Del)).Offset(, 1) = col
                [COLOR=navy]Next[/COLOR] Del
       [COLOR=navy]End[/COLOR] If
.Item(Dn.value) = Q
[COLOR=navy]End[/COLOR] If
Deb = 0: Cred = 0
[COLOR=navy]Next[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
If your Debit/Credits are in column "A" starting row (2) and your References are in column "B", starting row (2) then
In column "C" where there is a matching Debit with Single/Multi Credits the code will place a Number defining each new Match of Debit /Credit.
The same unique number will be in the same matching cells.

Code: 
[COLOR=navy]Sub[/COLOR] MG11Apr43
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Deb [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] Cred [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Del [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Dn.Offset(, -1) < 0 [COLOR=navy]Then[/COLOR]
        Deb = Dn.Offset(, -1)
       [COLOR=navy]ElseIf[/COLOR] Dn.Offset(, -1) > 0 [COLOR=navy]Then[/COLOR]
             Cred = Dn.Offset(, -1)
          [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
    .Add Dn.value, Array(Dn.Address, Deb, Cred, "")
[COLOR=navy]Else[/COLOR]
Q = .Item(Dn.value)
[COLOR=navy]If[/COLOR] Dn.Offset(, -1) > 0 [COLOR=navy]Then[/COLOR]
      Q(2) = Q(2) + Dn.Offset(, -1)
    [COLOR=navy]Else[/COLOR]
          Q(1) = Dn.Offset(, -1)
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Q(3) = "" [COLOR=navy]Then[/COLOR]
       Q(3) = Q(3) & Q(0) & "," & Dn.Address
    [COLOR=navy]Else[/COLOR]
           Q(3) = Q(3) & "," & Dn.Address
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Q(1) + Q(2) = 0 [COLOR=navy]Then[/COLOR]
        col = col + 1
         Ray = Split(Q(3), ",")
              [COLOR=navy]For[/COLOR] Del = 0 To UBound(Ray)
                   Range(Ray(Del)).Offset(, 1) = col
                [COLOR=navy]Next[/COLOR] Del
       [COLOR=navy]End[/COLOR] If
.Item(Dn.value) = Q
[COLOR=navy]End[/COLOR] If
Deb = 0: Cred = 0
[COLOR=navy]Next[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...



Hi Mick,

This is what I am looking for but if you look at the below in bold, the macro assigned -1000 A against 1000 A. Is there a way to overcome this? many thanks in Advance.

[TABLE="width: 192"]
<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]-100[/TD]
[TD="class: xl65, width: 64"]A[/TD]
[TD="class: xl64, width: 64"]1[/TD]
[/TR]
[TR]
[TD="class: xl65"]-1000[/TD]
[TD="class: xl65"]A[/TD]
[TD="class: xl64"]1[/TD]
[/TR]
[TR]
[TD="class: xl64"]-3000[/TD]
[TD="class: xl64"]B[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl64"]-5000[/TD]
[TD="class: xl64"]B[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl64"]-8000[/TD]
[TD="class: xl64"]C[/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl65"]100[/TD]
[TD="class: xl65"]A[/TD]
[TD="class: xl64"]1[/TD]
[/TR]
[TR]
[TD="class: xl65"]100[/TD]
[TD="class: xl65"]A[/TD]
[TD="class: xl64"]1[/TD]
[/TR]
[TR]
[TD="class: xl65"]800[/TD]
[TD="class: xl65"]A[/TD]
[TD="class: xl64"]1[/TD]
[/TR]
[TR]
[TD="class: xl64"]2000[/TD]
[TD="class: xl64"]B[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl64"]3000[/TD]
[TD="class: xl64"]B[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl64"]3000[/TD]
[TD="class: xl64"]B[/TD]
[TD="class: xl64"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
201
Omran Y
O
M
  • Solved
move and delete rows contains minus and positive value from range to another
Replies
8
Views
98
Mussa
M
A
  • Solved
Create accounts by user form to show balance by calculation for two columns
Replies
4
Views
110
abdo meghari
A
A
  • Question Question
Create list by combining for specific tab contains colors
Replies
0
Views
234
Alaa mg
A
A
  • Solved
Compare two sheets based on lastrow with highlighted cells
2 3
Replies
26
Views
307
mumps
mumps

Forum statistics

Threads
1,224,503
Messages
6,179,135
Members
452,890
Latest member
Nikhil Ramesh

Share this page

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