Debits and Credits to offset in a column

K

kjaan

New Member
Joined
Feb 2, 2011
Messages
20
Hi,
I have a large data that I exported in excel that include debit and credit in a column. I would like to find an easier way to pair the debit and credit to offset each other by a formula and easily find the variance. So the column would look something like this.

Column A
250
400
350
-250
410
-400
-350
600
-410
 
Sort by date Sort by votes
I assumed (wrongly obviously) that the reference in column B was unique. I will have to have a think about and get back to you if I can of something as it's late here in Aus now.

Someone else may (hopefully :)) provide a nifty solution in the meantime.
 
Upvote 0

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Actually - if you live with the numbers in Col. A being bolded (you could write simple code to unbold them if it's a real issue) this will do the job:

Code: 
Option Explicit
Sub Macro1()

    Dim lngEndRow    As Long
    Dim rngMyCell    As Range
    Dim rngMatchCell As Range
        
    Application.ScreenUpdating = False
    
    lngEndRow = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Each rngMyCell In Range("A1:A" & lngEndRow)
        If Val(rngMyCell) > 0 And rngMyCell.Font.Bold = False Then  'Only try and match the first reference if its amount is positive
            For Each rngMatchCell In Range("A1:A" & lngEndRow)
                If Val(rngMatchCell) * -1 = Val(rngMyCell) And rngMatchCell.Offset(0, 1) = rngMyCell.Offset(0, 1) Then
                    rngMyCell.Offset(0, 2).Value = rngMyCell 'Move original amount
                    rngMatchCell.Offset(0, 2).Value = rngMatchCell 'Move matched amount
                    rngMyCell.Offset(0, 3).Value = rngMyCell.Offset(0, 1) 'Move original reference number
                    rngMatchCell.Offset(0, 3).Value = rngMatchCell.Offset(0, 1) 'Move matched reference number
                    Range("A" & rngMyCell.Row & ":B" & rngMyCell.Row).ClearContents
                    Range("A" & rngMatchCell.Row & ":B" & rngMatchCell.Row).ClearContents
                    Exit For
                End If
            Next rngMatchCell
        ElseIf Val(rngMyCell) < 0 Then
                rngMyCell.Font.Bold = True
                For Each rngMatchCell In Range("A1:A" & lngEndRow)
                    If Val(rngMatchCell) * -1 = Val(rngMyCell) Then
                        rngMatchCell.Font.Bold = True
                        Exit For
                    End If
                Next rngMatchCell
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

Robert
 
Last edited:
Upvote 0
Trebor76 said:
Actually - if you live with the numbers in Col. A being bolded (you could write simple code to unbold them if it's a real issue) this will do the job:

Code: 
Option Explicit
Sub Macro1()

    Dim lngEndRow    As Long
    Dim rngMyCell    As Range
    Dim rngMatchCell As Range
        
    Application.ScreenUpdating = False
    
    lngEndRow = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Each rngMyCell In Range("A1:A" & lngEndRow)
        If Val(rngMyCell) > 0 And rngMyCell.Font.Bold = False Then  'Only try and match the first reference if its amount is positive
            For Each rngMatchCell In Range("A1:A" & lngEndRow)
                If Val(rngMatchCell) * -1 = Val(rngMyCell) And rngMatchCell.Offset(0, 1) = rngMyCell.Offset(0, 1) Then
                    rngMyCell.Offset(0, 2).Value = rngMyCell 'Move original amount
                    rngMatchCell.Offset(0, 2).Value = rngMatchCell 'Move matched amount
                    rngMyCell.Offset(0, 3).Value = rngMyCell.Offset(0, 1) 'Move original reference number
                    rngMatchCell.Offset(0, 3).Value = rngMatchCell.Offset(0, 1) 'Move matched reference number
                    Range("A" & rngMyCell.Row & ":B" & rngMyCell.Row).ClearContents
                    Range("A" & rngMatchCell.Row & ":B" & rngMatchCell.Row).ClearContents
                    Exit For
                End If
            Next rngMatchCell
        ElseIf Val(rngMyCell) < 0 Then
                rngMyCell.Font.Bold = True
                For Each rngMatchCell In Range("A1:A" & lngEndRow)
                    If Val(rngMatchCell) * -1 = Val(rngMyCell) Then
                        rngMatchCell.Font.Bold = True
                        Exit For
                    End If
                Next rngMatchCell
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

Robert
Click to expand...

This one works, well done! :)
My respect!
 
Upvote 0
Hi Robert,

I need one last assistance from you regarding this macro

I just need to insert one column invoice number as column A.
So column A will be invoice number, column B values, and column C references. Macro will just have to match the same values and references, as usual, and to move matched values from all three columns(from column A to column D, from column B to column E and from column C to column F)

I hope that this makes sense
Click to expand...

Please do not PM members asking for help as it against forum rules and defeats the purpose of having a public forum. Thanks.

I'm surprised you're not matching on invoice number instead (or as well as) reference but see how this goes:

Code: 
Option Explicit
Sub Macro1()

    Dim lngEndRow    As Long
    Dim rngMyCell    As Range
    Dim rngMatchCell As Range
        
    Application.ScreenUpdating = False
    
    lngEndRow = Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Each rngMyCell In Range("B1:B" & lngEndRow) 'Amount column
        If Val(rngMyCell) > 0 And rngMyCell.Font.Bold = False Then  'Only try and match the first reference if its amount is positive
            For Each rngMatchCell In Range("B1:B" & lngEndRow)
                If Val(Range("B" & rngMatchCell.Row)) * -1 = Val(Range("B" & rngMyCell.Row)) And Range("C" & rngMatchCell.Row) = Range("C" & rngMyCell.Row) Then
                    With Range("A" & rngMyCell.Row & ":C" & rngMyCell.Row)
                        .Copy Destination:=Range("D" & rngMyCell.Row)
                        .ClearContents
                    End With
                    With Range("A" & rngMatchCell.Row & ":C" & rngMatchCell.Row)
                        .Copy Destination:=Range("D" & rngMatchCell.Row)
                        .ClearContents
                    End With
                    Exit For
                End If
            Next rngMatchCell
        ElseIf Val(rngMyCell) < 0 Then
                rngMyCell.Font.Bold = True
                For Each rngMatchCell In Range("B1:B" & lngEndRow)
                    If Val(rngMatchCell) * -1 = Val(rngMyCell) Then
                        Range("B" & rngMatchCell.Row).Font.Bold = True
                        Exit For
                    End If
                Next rngMatchCell
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

Robert
 
Upvote 0
Apologies, didn't know about that rule.
This is a just part of one big macro that I am making, and the rule is to match the same positive and negative values(Invoices with Credits) only if they have same ref numbers, and I am using invoice number only as lookup value in following parts.
Thank you for your help it's much appreciated!
 
Upvote 0
Trebor76 said:
Actually - if you live with the numbers in Col. A being bolded (you could write simple code to unbold them if it's a real issue) this will do the job:

Code: 
Option Explicit
Sub Macro1()

    Dim lngEndRow    As Long
    Dim rngMyCell    As Range
    Dim rngMatchCell As Range
        
    Application.ScreenUpdating = False
    
    lngEndRow = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Each rngMyCell In Range("A1:A" & lngEndRow)
        If Val(rngMyCell) > 0 And rngMyCell.Font.Bold = False Then  'Only try and match the first reference if its amount is positive
            For Each rngMatchCell In Range("A1:A" & lngEndRow)
                If Val(rngMatchCell) * -1 = Val(rngMyCell) And rngMatchCell.Offset(0, 1) = rngMyCell.Offset(0, 1) Then
                    rngMyCell.Offset(0, 2).Value = rngMyCell 'Move original amount
                    rngMatchCell.Offset(0, 2).Value = rngMatchCell 'Move matched amount
                    rngMyCell.Offset(0, 3).Value = rngMyCell.Offset(0, 1) 'Move original reference number
                    rngMatchCell.Offset(0, 3).Value = rngMatchCell.Offset(0, 1) 'Move matched reference number
                    Range("A" & rngMyCell.Row & ":B" & rngMyCell.Row).ClearContents
                    Range("A" & rngMatchCell.Row & ":B" & rngMatchCell.Row).ClearContents
                    Exit For
                End If
            Next rngMatchCell
        ElseIf Val(rngMyCell) < 0 Then
                rngMyCell.Font.Bold = True
                For Each rngMatchCell In Range("A1:A" & lngEndRow)
                    If Val(rngMatchCell) * -1 = Val(rngMyCell) Then
                        rngMatchCell.Font.Bold = True
                        Exit For
                    End If
                Next rngMatchCell
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

Robert
Click to expand...

Hi Robert,

I am using this macro of yours, and sometimes it does the wrong matching.
For example:
Column A Column B
25 123
-25 456
25 456
-25 465
Based on this assumptions it needs to match two bolded items but instead od that macro matched two middle values with reference 456 and with negative value first.
Do you have any idea why this happens?
 
Upvote 0
Do you have any idea why this happens?
Click to expand...

Not without seeing the data. If you can post your workbook (devoid of any sensitive data) via a file sharing site like www.box.com with how the data should look before and after the macro has run, it may help.
 
Upvote 0
It's asking for me to "Sign In to Your Account" via an email and password??
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Create .dat file from excel data for payment upload
Replies
1
Views
83
sailingmike49
S
A
  • Question
Editable search
Replies
2
Views
152
Aqusmacro
A
L
  • Question
Excel VBA - Return Specific Data from Master Sheet Based on Date Search + Duplicate Certain Items
Replies
1
Views
475
LookingForHelp1
L
M
  • Solved
Assistance Needed with Excel VBA Code for Color Formatting
2
Replies
10
Views
807
RudRud
R
S
  • Question
Using criteria to sum data from another sheet.
Replies
1
Views
361
SandieConfused
S

Forum statistics

Threads
1,215,779
Messages
6,126,842
Members
449,343
Latest member
DEWS2031

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