The difference of two rows of numbers

[sphinxwt]

Hi all,

I have a set of code to generate a new column of numbers that are present in column B but not in column A. But now I have some data stored in rows, and I have troubles to modify the code to generate a new row to show the difference of two rows of numbers. can someone pls advise. Thx a lot!

here is the original code for columns

Sub Set_Difference()
Dim colA, colB, ArrList()
Dim i As Integer, j As Integer
Dim theList As New Collection
Dim IsExist As Boolean

Range("F2:F65536").ClearContents

On Error Resume Next
colA = Range("A2:" & "A" & [A65536].End(xlUp).Row)
colB = Range("B2:" & "B" & [B65536].End(xlUp).Row)
For i = 1 To [B65536].End(xlUp).Row - 1
  For j = 1 To [A65536].End(xlUp).Row - 1
   If colB(i, 1) = colA(j, 1) Then
     IsExist = True
     Exit For
   End If
  Next
  If IsExist Then
    IsExist = False
  Else
    theList.Add colB(i, 1), CStr(colB(i, 1))
  End If
Next

ReDim ArrList(1 To theList.Count, 1 To 1)
For i = 1 To theList.Count
  ArrList(i, 1) = theList(i)
Next
Range("F2:" & "F" & theList.Count + 1).Value = ArrList

End Sub

 

[mirabeau]

Difference?
Do you mean one subtracted from the other?
Do you mean listing numbers in one row that are not in the other?
Or ...?

 

[sphinxwt]

Listing numbers in one row that are not present in the other.

 

[mirabeau]

Here's a code which you can try.

It supposes you use Windows OS and not Mac OS. Maybe since you use collections you might be using a Mac, in which case further consideration needed.

Sub diffs()
Dim dic As Object
Dim nd1 As Long
Dim nd2 As Long
Dim c()
Dim k As Long
Dim e As Variant

Set dic = CreateObject("scripting.dictionary")
Set nd1 = Cells(1, Columns.Count).End(xlToLeft)
Set nd2 = Cells(2, Columns.Count).End(xlToLeft)
ReDim c(1 To nd2)
For Each e In Cells(1, 1).Resize(, nd1).Value
    dic(e) = 1
Next
For Each e In Cells(2, 1).Resize(, nd2).Value
    If Not dic.exists(e) Then
        k = k + 1
        c(k) = e
    End If
Next
Cells(4, 1).Resize(, k) = c
End Sub

In row4 this lists numbers that exist in row2 but not in row1.

 

[sphinxwt]

Thank you mirabeau, using the dictionary object sure made the code way more slim and cool. But I tested it, it still shows "compile error: object required."...

 

[mirabeau]

What OS and Excel version do you have?

Do you have data in both rows 1 and 2 on which to test the code?

Are there any numbers in row2 that are different from row1?

In the second to last line, change to If k > 0 then Cells(4, 1).Resize(, k) = c

I tested that code and it worked well for me without error.

Was there a specific line where the error occurred? (Second to last line maybe?)

 

[sphinxwt]

Hey, I'm using Win7 and Excel 2010,
and the error occurred on the second executive line
"Set nd1 = Cells(1, Columns.Count).End(xlToLeft)"

I tested it with different data sets, still with this error...

 

[sphinxwt]

I solved the problem using the original idea of double loops instead of dictionary object.
Now I have a new problem, my database has two worksheets, each having 8000 rows of records. I want to compare the difference between the same rows from these two sheets, and to generate the output rows in a third worksheet. It seems that I need to add another loop to do the job. Anyone please have advise on how to do this? I have troubles to Redim the rowA and rowB.

Here is the code to perform comparison of single records:

Sub Set_Difference_test_multisheets()
Dim rowA, rowB, ArrList()
Dim i As Integer, j As Integer
Dim theList As New Collection
Dim IsExist As Boolean

Sheets(3).Range("B1:IV1").ClearContents
On Error Resume Next
rowA = Sheets(1).Range("B1", Sheets(1).Range("IV1").End(xlToLeft))
rowB = Sheets(2).Range("B1", Sheets(2).Range("IV1").End(xlToLeft))
For i = 1 To Sheets(2).[IV1].End(xlToLeft).Column - 1
  For j = 2 To Sheets(1).[IV1].End(xlToLeft).Column - 1
   If rowB(1, i) = rowA(1, j) Then
     IsExist = True
     Exit For
   End If
  Next
  If IsExist Then
    IsExist = False
  Else
    theList.Add rowB(1, i), CStr(rowB(1, i))
  End If
Next
ReDim ArrList(1 To 1, 1 To theList.Count)
For i = 1 To theList.Count
  ArrList(1, i) = theList(i)
Next
  Sheets(3).[B1].Resize(1, theList.Count).Value = ArrList
End Sub

 

[mirabeau]

Hey, I'm using Win7 and Excel 2010,
and the error occurred on the second executive line
"Set nd1 = Cells(1, Columns.Count).End(xlToLeft)"

I tested it with different data sets, still with this error...

Hey,

Sorry about that. Obvious error by me. I changed my mind somewhere between testing the code and posting it. Needs change in 2 lines and should work fine.

Sub diffs()
Dim dic As Object
Dim nd1 As Long
Dim nd2 As Long
Dim c()
Dim k As Long
Dim e As Variant

Set dic = CreateObject("scripting.dictionary")
nd1 = Cells(1, Columns.Count).End(xlToLeft).Column
nd2 = Cells(2, Columns.Count).End(xlToLeft).Column
ReDim c(1 To nd2)
For Each e In Cells(1, 1).Resize(, nd1).Value
    dic(e) = 1
Next
For Each e In Cells(2, 1).Resize(, nd2).Value
    If Not dic.exists(e) Then
        k = k + 1
        c(k) = e
    End If
Next
Cells(4, 1).Resize(, k) = c
End Sub

Incidentally, what is the nature of your numbers?
Are they integers, currency, dates or other? If they are decimal, say 7.53624, do you want a fuzzy match/nonmatch, or need it be exact to the last decimal place?

 

[mirabeau]

Now I have a new problem, my database has two worksheets, each having 8000 rows of records. I want to compare the difference between the same rows from these two sheets, and to generate the output rows in a third worksheet. It seems that I need to add another loop to do the job. Anyone please have advise on how to do this?

Try the following code on some test data and see if it's like what you want.

Sub diffs() '15 July 11
Dim dic As Object
Dim nc1 As Long, nc2 As Long
Dim rng1, rng2
Dim nrow As Long
Dim c()
Dim i As Long, j As Long, k As Long
Dim u As Long

nrow = 8000
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1
With Sheets("sheet1").Cells
    nc1 = .Find("*", after:=.Cells(1), searchorder:=xlByRows, _
        searchdirection:=xlPrevious).Column
    rng1 = .Cells(1).Resize(nrow, nc1)
End With
With Sheets("sheet2").Cells
    nc2 = .Find("*", after:=.Cells(1), searchorder:=xlByRows, _
        searchdirection:=xlPrevious).Column
    rng2 = .Cells(1).Resize(nrow, nc2)
End With
ReDim c(1 To nrow, 1 To Application.Max(nc1, nc2))

For i = 1 To nrow
For j = 1 To nc1
    If rng1(i, j) <> Empty Then dic(rng1(i, j)) = 1
Next j
For j = 1 To nc2
    If rng2(i, j) <> Empty And Not dic.exists(rng2(i, j)) Then
        k = k + 1
        If k > 0 Then c(i, k) = rng2(i, j)
    End If
Next j
If k > u Then u = k
k = 0
dic.RemoveAll
Next i
Sheets("sheet3").Range("A1").Resize(nrow, u) = c
End Sub

Are your numbers integers or currency or other?