Script which can check if a debit has a corresponding credit [Solved/Closed]

dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 9, 2015 at 07:44 AM - Latest reply: dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen
- Sep 24, 2015 at 02:30 AM
Hello,

I am new to VBA, and I am searching for a script which can check if a debit has a corresponding credit (same value bue with -/+), and highlight the cells in green. Cells that doesn't have a corresponding cell needs to be highlighted in red. I want to check from cell B2 to L56, as there are several subsidiarys I need to match.

I have been looking everywhere for this, but with no luck so far.

I hope you are able to help.

Regards,

Dennis
See more 

11 replies

Best answer
1
Thank you
Using the file you posted.
I skipped the zero values, as these would all match each other.
You can change the ranges to suite.


Sub finddupes()
dim found as Boolean

For Each mycell In Worksheets("Ark1").Range("B2:L34")
myvalue = Abs(mycell.Value)
If myvalue <> 0 Then
found = False
For Each chkcell In Worksheets("Ark1").Range("B2:L34")
If mycell <> chkcell Then
If myvalue = Abs(chkcell.Value) Then
chkcell.Interior.ColorIndex = 4 ' Green
mycell.Interior.ColorIndex = 4
found = True
End If
End If
Next
If found = False Then mycell.Interior.ColorIndex = 3 'Red
End If
Next

End Sub

Thank you, RayH 1

Something to say? Add comment

CCM has helped 1683 users this month

dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 17, 2015 at 03:16 AM
A comment though... Would it be possible to add another color, say yellow... For Numbers that are within, say 100, of each other? So I know that it is only a minor difference?
RayH 122 Posts Tuesday August 31, 2010Registration dateContributorStatus June 20, 2016 Last seen > dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 17, 2015 at 12:24 PM
Here's an updated version that includes the check for minor difference.
I have added comments to explain what is going on and made important values variables so they only need to be set once. This makes it easier to modify for changes.


Sub finddupes()
Dim found As Boolean
Dim diff As Long
Dim myrng As Range
Dim highvalue As Long

Application.ScreenUpdating = False ' Turn off screen updates to speed up the routine

Set myrng = Worksheets("Ark1").Range("B2:L34") ' set the range of the data being checked
highvalue = 100 ' set the value of the difference

myrng.Interior.ColorIndex = 0 'clear background of cell in range

For Each mycell In myrng
myValue = Abs(mycell.Value) ' get the absolute value of the source cell
If myValue <> 0 Then ' is the value being match zero? No? Carry on doing the match
found = False ' cleat the found a match flag

For Each chkcell In myrng
If mycell <> chkcell Then 'not the same cell, carry on...
mychkValue = Abs(chkcell.Value) 'get the absolute value of the target cell
If mychkValue <> 0 Then ' target cell value not zero
diff = Abs(myValue - mychkValue) ' calc difference between the source and target cells

If diff > 0 And diff < highvalue Then ' is the difference between 0 and 100, Yes? Set to Yellow
chkcell.Interior.ColorIndex = 6 ' Yellow
mycell.Interior.ColorIndex = 6
found = True ' set the flag to say we found a match
ElseIf myValue = mychkValue Then ' otherwise must be equal, so set to Green
chkcell.Interior.ColorIndex = 4 ' Green
mycell.Interior.ColorIndex = 4
found = True ' set the flag to say we found a match
End If

End If
End If
Next
If found = False Then mycell.Interior.ColorIndex = 3 'did we find a match? No? Then set to Red
End If
Next

Application.ScreenUpdating = True ' Turn screen updates back on

End Sub

dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen > RayH 122 Posts Tuesday August 31, 2010Registration dateContributorStatus June 20, 2016 Last seen - Sep 23, 2015 at 02:54 AM
Hello RayH and thank you for all your help. This is exactly what I am looking for, but there seems to be some minor issue with it. If I have 2 cells with the following values: 213.154,33
and -213.154,33333 the cells both turn red, where it should turn yellow.
It would be prefered though if 2 cells are equal before the decimals, that they turn green, but if not they should atleast go yellow, so I can check them afterwards.

Sorry for the inconvinience!
RayH 122 Posts Tuesday August 31, 2010Registration dateContributorStatus June 20, 2016 Last seen > dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 23, 2015 at 11:22 AM
I found a couple of issues (bugs) that I have now corrected.
1. diff is now a Double variable type.
2.The comparison of the cell location was being done incorrectly.

If you want to ignore the decimal places then using these in place of the originals will do that for you:
myvalue = Int(Abs(mycell.Value)) ' get the absolute value of the source cell

and
mychkvalue = Int(Abs(chkcell.Value)) 'get the absolute value of the target cell



Sub finddupes()
Dim found As Boolean
Dim diff As Double
Dim myrng As Range
Dim highvalue As Long
Dim myvalue As Double
Dim mychkvalue As Double

Application.ScreenUpdating = False  ' Turn off screen updates to speed up the routine

Set myrng = Worksheets("Ark1").Range("B2:L34")  ' set the range of the data being checked
highvalue = 100   ' set the value of the difference

myrng.Interior.ColorIndex = 0       'clear background of cell in range

For Each mycell In myrng
myvalue = Abs(mycell.Value) ' get the absolute value of the source cell
If myvalue <> 0 Then    ' is the value being match zero? No? Carry on doing the match
found = False   ' clear the found a match flag
    For Each chkcell In myrng
        If mycell.Address <> chkcell.Address Then 'not the same cell, carry on...

            mychkvalue = Abs(chkcell.Value) 'get the absolute value of the target cell
            If mychkvalue <> 0 Then  ' target cell value not zero
                diff = Abs(myvalue - mychkvalue) ' calc difference between the source and target cells
                
                If diff > 0 And diff < highvalue Then ' is the difference between 0 and highvalue, Yes? Set to Yellow
                    chkcell.Interior.ColorIndex = 6 ' Yellow
                    mycell.Interior.ColorIndex = 6
                    found = True    ' set the flag to say we found a match
                ElseIf myvalue = mychkvalue Then    ' otherwise must be equal, so set to Green
                    chkcell.Interior.ColorIndex = 4 ' Green
                    mycell.Interior.ColorIndex = 4
                    found = True    ' set the flag to say we found a match
                End If
                
            End If
        End If
    Next
If found = False Then mycell.Interior.ColorIndex = 3 'did we find a match? No? Then set to Red
End If
Next

Application.ScreenUpdating = True   ' Turn screen updates back on

End Sub
dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 24, 2015 at 02:30 AM
Forget my last msg... Deleted it, ofc it should turn yellow.

This works perfectly now, thank you!
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Sep 10, 2015 at 04:16 AM
0
Thank you
please post a very small extract of your sheet
dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 10, 2015 at 06:30 AM
http://postimg.org/image/40hbtw8eb/

Here is the small extract of what you requested... I have started doing some of it manually, and as you can see I have put 2 rings around 2 cells that have an exact match (debit/credit)... The ones that are red, are ones where it doesn't have a match. As the numbers are large, I don't think it will ever occur that more than 2 cells have the same value.

I hope this makes sense.
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Sep 11, 2015 at 01:35 AM
0
Thank you
this is image. I cannot transfer data to my excel file. besides there should be column headings. It looks any data in any column may correspond with data in any other column, are you familiar with macro?

suggest save a sample file and send it(as an attchment) through "speedyshare.com"
dennisvhansen 7 Posts Wednesday September 9, 2015Registration date September 24, 2015 Last seen - Sep 16, 2015 at 02:45 AM
Sorry for the late reply, I have not been in the office since thursday.

I've uploaded it now.
There are column headings in the uploaded document.

http://www.speedyshare.com/P8SWD/Small-extract.xlsx

I am afraid, I am not too familiar with macros.