doubt on calculating difference vba/excel

[zmbd]

SANDRADEPAR:

+ We understand your question.

+ What we are waiting for is for you to tell us what it is that you are after. One time it's one thing, the next it appears you want something else.

+ Using the pseudo-code I gave you in post#14, it took me all of 20 minutes, and most of that was hand-checking against your dataset in the original post, to write the script for comparing the adjacent pairs - something you already have. If this isn't what you're after then you need to tell us what you've tried to do to fix the script

[codegazer]

Come on, Sandradepar.
You were very nearly there when you posted your code a week ago, but your code only ever compares adjacent pairs because you use j & j+1.
To find all results in each row, you will have to search from j to the end of the row

[zmbd]

codegazer, I think that is what SANDRADEPAR is after...
(from the post#12, using the data in post #1)
34-46, 46-61, 61-70, 70-73....
49-51, 51-55, 55-62, 62-63....

Which in this data set (in post#1) only occur 8 times and then only once in the rows where the pairs have a difference of 19 - and they are all negative in nature :)
It may be the case that SANDRADEPAR has one solution to the question at hand; however, SANDRADEPAR needs to clarify the actual goal.

What clouds the issue for me is the rows of numbers at the bottom of the example data in post#1:
16 11 || 88 3 || 2 25 0 || 73 61...

[SANDRADEPAR]

many thanks to all, codegazer and zmbd

What i'm trying to say (the main goal) is that to find ALL POSSIBLE SOLUTIONS THAT any two numbers within each line/row differ by 19 or its absolute value is 19 such as 58 - 39 = 19 or |58 - 39|= 19 or |39 - 58|= 19 for each line/row.

the code that i posted above is omitting some results in some lines (it displays only 1 pair per line/row in final results, and no more results, it is excluding some results, and i don't know why) and i dont know how to fix that.
See the code:

   Sub difference()
     
    Dim lngLastRow As Long
    Dim lngLastColumn As Long
    Dim lngMatch As Long
     
    Dim arrMatch(100) As Variant
    Dim arrMatchValues(100) As Variant
    Dim arrMatchValues2(100) As Variant
     
    Const valDif = 19
     
    lngMatch = 0
     
    Sheets("Plan1").Select
     
    lngLastRow = Sheets("Plan1").Range("A1").End(xlDown).Row
    lngLastColumn = Sheets("Plan1").Range("A1").End(xlToRight).Column
     
     
    For i = 1 To lngLastRow
        For j = 1 To lngLastColumn
                If Cells(i, j + 1).Value - Cells(i, j).Value = valDif Then
     
                    arrMatch(lngMatch) = Cells(i, j).Address
                    arrMatchValues(lngMatch) = Cells(i, j + 1).Value
                    arrMatchValues2(lngMatch) = Cells(i, j).Value
     
                    lngMatch = lngMatch + 1
     
                End If
        Next j
    Next i
     
    Sheets("Plan2").Select
     
    Cells(1, 1).Value = lngMatch & " records found"
     
    For i = 0 To lngMatch
     
        Cells(i + 1, 3).Value = arrMatch(i)
        Cells(i + 1, 5).Value = arrMatchValues(i)
        Cells(i + 1, 6).Value = arrMatchValues2(i)
     
    Next i
     
    End Sub

And try to apply it in a small sample :

54 60 63 66 67 68 72 75 82 84 100
50 51 56 58 61 62 67 68 90 92 94
44 47 50 54 61 64 80 92 93 95 100
53 54 61 64 69 84 92 94 97 98 99
53 57 59 78 79 83 85 86 93 96 100
52 53 57 58 59 63 68 73 76 77 81
53 58 60 69 72 79 85 86 88 91 98
48 62 69 74 76 78 80 83 93 97 99
50 51 55 57 61 69 71 72 85 89 96
38 40 43 59 60 63 64 72 73 85 93
40 48 54 56 57 59 67 69 73 86 92
39 43 46 55 58 62 74 82 95 97 100

You'll see that some results are missing because as my friend codegazer said:

codegazer: " your code only ever compares adjacent pairs because you use j & j+1.
To find all results in each row, you will have to search from j to the end of the row".

The problem with my code is what u said above, but i'm not able to fix that, because I have very small limited knowledge of VB in Excel.

Can help me?

many thanks

[codegazer]

You are nearly there.
A couple of adjustments as below should show the results

For i = 1 To lngLastRow
 For j = 1 To lngLastColumn-1
    'extra loop to search to end of row
   for n= j+1 to lnglastcolumn
     If abs(Cells(i, n).Value - Cells(i, j).Value) = valDif Then

       arrMatch(lngMatch) = Cells(i, j).Address
       arrMatchValues(lngMatch) = Cells(i, n).Value
       arrMatchValues2(lngMatch) = Cells(i, j).Value

       lngMatch = lngMatch + 1

     End If
   Next n
 Next j
Next i

[zmbd]

Attached is a file with one approach to the solution:

To use:
>always scan files with your antivirus.
Select the upper-right-hand cell of the data-table.
Sheet1!A1
Excel2013>Ribbo n>View>Macros>V iewMacros
[LoopAndCompareA djecentCells]
Does just that, with a row of data compares the adjacent cells
a-b, b-c, c-d, etc...
Repeating for each row

[LoopAndCompareW ithinRow]
Does just that, takes each cell in turn and compares with the remaining cells within the row
a-b, a-c, a-d.... b-c, b-d, b-e,.... c-d, c-e, c-f, etc....
Repeating for each row

Following is the source code for module, insert a standard module or copy and paste the following in to the "ThisWorkbo ok" module of the workbook:

All of the output is being sent to the Immediate pane - open with <ctrl><g>
>> This pane will scroll thru very quickly so not every result will be visible in the pane
LINE 27 and LINE 71
Are the comparison lines for the ABS(LCell-RCell)=19
These are one of the lines you will need to modify to store your results where you need them... I did not code this because you didn't indicate what you wanted done with this information.

Personally, I would either open a text file for output and write the results or insert a new worksheet and insert the values there as found.

Option Explicit 'DO NOT DUPLICATE THIS LINE IN YOUR MODULE

Sub loopandcompareadjecentcells()
Dim zDifference As Long
Dim zStartCell As Range
Dim zLcell As Range
Dim zRcell As Range
Dim zrowoffset As Long
Dim zclmoffset As Long
'
'using the currently selected cell as the staring point
zrowoffset = 0
zclmoffset = 0
'
'set up for the first compair and then enter the loop
Set zStartCell = ActiveCell
Set zLcell = zStartCell
Set zRcell = zLcell.Offset(zrowoffset, (zclmoffset + 1))
'
'Drop out of the procedure if the first cell is empty other wise continue until the first empty cell is found
Do Until IsEmpty(zLcell)
'Row loop
'Drop out of the loop is the cell is empty else continue until the first empty cell is found
Debug.Print "row= " & zLcell.Row
    'loop until the first empty cell is found
    Do Until IsEmpty(zLcell) Or IsEmpty(zRcell)
        If Abs((zLcell.Value - zRcell.Value)) = 19 Then Debug.Print Tab(10); zLcell.Value & "-" & zRcell.Value & "="; (zLcell.Value - zRcell.Value)
        zclmoffset = zclmoffset + 1
        Set zLcell = zStartCell.Offset(zrowoffset, zclmoffset)
        Set zRcell = zStartCell.Offset(zrowoffset, (zclmoffset + 1))
    Loop
    zrowoffset = zrowoffset + 1
    zclmoffset = 0
    Set zLcell = zStartCell.Offset(zrowoffset, zclmoffset)
    Set zRcell = zStartCell.Offset(zrowoffset, (zclmoffset + 1))
Loop
If Not zStartCell Is Nothing Then Set zStartCell = Nothing
If Not zLcell Is Nothing Then Set zLcell = Nothing
If Not zRcell Is Nothing Then Set zRcell = Nothing
Debug.Print "done"
End Sub

Sub loopandcomparewithinrow()
Dim zDifference As Long
Dim zStartCell As Range
Dim zLcell As Range ' cell on the left ( left - right = value )
Dim zRcell As Range ' cell on the right ( left - right = value )
Dim zrowoffset As Long ' Which row in the data table
Dim zleftoffset As Long ' pointer relative to the table start
Dim zrightoffset As Long ' pointer relative to the table start
'
zrowoffset = 0 ' Start in the first row where the currently selected cell is located
zleftoffset = 0 ' Using the currently slected cell as the starting point in the row
zrightoffset = 1 ' pull the adjcent cell to the starting cell
'
'set up for the first compair and then enter the loop
Set zStartCell = ActiveCell
Set zLcell = zStartCell
Set zRcell = zLcell.Offset(zrowoffset, (zleftoffset + zrightoffset))
'
'now if there isn't anything in the first cell then drop out of the procedure otherwise keep going until we have an empty cell
Do Until IsEmpty(zLcell)
'Row loop
Debug.Print "row= " & zLcell.Row
    'Start left cell loop
    'once again, drop out if nothing is found in the cell else keep going until the first empty cell
    Do Until IsEmpty(zLcell)
        'Start right loop
        'once again, drop out if nothing is found in the cell else keep going until the first empty cell
        Do Until IsEmpty(zRcell)
            If Abs((zLcell.Value - zRcell.Value)) = 19 Then Debug.Print Tab(10); zLcell.Value & "-" & zRcell.Value & "="; (zLcell.Value - zRcell.Value)
            zrightoffset = zrightoffset + 1
            Set zRcell = zStartCell.Offset(zrowoffset, (zleftoffset + zrightoffset))
        Loop 'right cell
        zleftoffset = zleftoffset + 1
        zrightoffset = 1
        Set zLcell = zStartCell.Offset(zrowoffset, zleftoffset)
        Set zRcell = zStartCell.Offset(zrowoffset, (zleftoffset + zrightoffset))
    Loop 'left cell
    zrowoffset = zrowoffset + 1
    zleftoffset = 0
    Set zLcell = zStartCell.Offset(zrowoffset, zleftoffset)
    Set zRcell = zStartCell.Offset(zrowoffset, (zleftoffset + 1))
Loop 'row
If Not zStartCell Is Nothing Then Set zStartCell = Nothing
If Not zLcell Is Nothing Then Set zLcell = Nothing
If Not zRcell Is Nothing Then Set zRcell = Nothing
Debug.Print "done"
End Sub

[SANDRADEPAR]

thank you codegazer ,
i inserted the adjustments that u provided me above into the code:

 Sub difference()
     
    Dim lngLastRow As Long
    Dim lngLastColumn As Long
    Dim lngMatch As Long
     
    Dim arrMatch(100) As Variant
    Dim arrMatchValues(100) As Variant
    Dim arrMatchValues2(100) As Variant
     
    Const valDif = 19
     
    lngMatch = 0
     
    Sheets("Sheet1").Select
     
    lngLastRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
    lngLastColumn = Sheets("Sheet1").Range("A1").End(xlToRight).Column
     
     
     For i = 1 To lngLastRow
 For j = 1 To lngLastColumn - 1
    'extra loop to search to end of row
   For n = j + 1 To lngLastColumn
     If Abs(Cells(i, n).Value - Cells(i, j).Value) = valDif Then
 
       arrMatch(lngMatch) = Cells(i, j).Address
       arrMatchValues(lngMatch) = Cells(i, n).Value
       arrMatchValues2(lngMatch) = Cells(i, j).Value
 
       lngMatch = lngMatch + 1
 
     End If
   Next n
 Next j
Next i
     
    Sheets("Sheet2").Select
     
    Cells(1, 1).Value = lngMatch & " records found"
     
    For i = 0 To lngMatch
     
        Cells(i + 1, 3).Value = arrMatch(i)
        Cells(i + 1, 5).Value = arrMatchValues(i)
        Cells(i + 1, 6).Value = arrMatchValues2(i)
     
    Next i
     
    End Sub

I tried it several times , but nothing happened.
Can you see if i made the aproppriate adjustments right in the code?

merry christmas

God bless you forever

[SANDRADEPAR]

many thanks for your help zmbd,
i try to execute your 964972.zip file so many times in my EXCEL 2010.But it didn't work.
I run loopandcomparea djecentcells first, and after i run LoopAndCompareW ithinRow . Nothing happened.
It didn't write any results.
All the test that i made in EXCEL 2010 were unsuccessfull.
I don't know if the codes of loopandcomparea djecentcells and LoopAndCompareW ithinRow are compatible with old EXCEL 2010 ...
( i can't afford for a new whole OFFICE 2015 nowadays, cause i 'm broken)

Happy christmas

God bless you ad aeternum

[zmbd]

1) Forgive me for the stupid tech-support questions: When you downloaded the file did you unzip it?

2) This code compiles and runs on a 2007, 2010, and 2013 - 32 and 64bit office installs. (Have a friend with 2007, I have a runtime 2010 on the laptop, and bit 32 and 64bit versions of 2013 on the desktop PCs (although the 64bit is going to be reformatted by my IT-staff over the new year)

3) These are not functions
This code is designed to take the activecell and use that as a starting point.
If you unzip the file, open in Excel, select sheet one, cell A1, and run either of the VBA scripts, it will work (see the instructions)

4) The output is to the Debug window, press <alt><F11> to open the editor, <ctrl><g> to open the immediate pane (IP).

4a) Because the dataset is so large, the output to the IP will scroll off of the top; thus, you will not see all of the results.

4b) To store the results you will need to modify the debug.print lines to store these in the desired location.

5) the actual script is in the post's code block.

-z