Solved: Compare Column Data

[vzachin]

hi,

i have the following code from Krishna Kumar in January 2008 which compared data in 2 columns (B & F) and placed the no matches in column M.

how can i modify this code to include the data from column e and place that in column L?

i will have about 5000 rows in each column. i suppose i can do a v-lookup to grab the data.




Sub kTest()



Dim a, i As Long, j As Long, w(), b, x

Dim Rng1 As Range, Rng2 As Range, r As Long
Set Rng2 = Range("b5", Range("b" & Rows.Count).End(xlUp))
Set Rng1 = Range("f5", Range("f" & Rows.Count).End(xlUp))
a = Rng1.Value
b = Rng2.Value
r = Application.Max(UBound(a, 1), UBound(b, 1))
ReDim w(1 To r, 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 1)) Then
x = Application.Match(a(i, 1), b, 0)
If IsError(x) Then j = j + 1: w(j, 1) = a(i, 1)
End If
Next
If j > 0 Then Range("m5").Resize(j).Value = w
End Sub



thanks
zach

[Digita]

Not quite sure what exactly your requirements are. However, I take that you want to populate column L with the corresponding numbers based on the list in columns E:F. If so, the modified code below should do the trick:

Sub kTest()
Dim a, i As Long, j As Long, w(), b, x, cel
Dim Rng1 As Range, Rng2 As Range, r As Long
Set Rng2 = Range("b5", Range("b" & Rows.Count).End(xlUp))
Set Rng1 = Range("f5", Range("f" & Rows.Count).End(xlUp))
a = Rng1.Value
b = Rng2.Value
r = Application.Max(UBound(a, 1), UBound(b, 1))
ReDim w(1 To r, 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 1)) Then
x = Application.Match(a(i, 1), b, 0)
If IsError(x) Then j = j + 1: w(j, 1) = a(i, 1)
End If
Next
If j > 0 Then Range("m5").Resize(j).Value = w

For i = 5 To j + 4
For Each cel In Rng1
If cel = Range("M" & i) Then Cells(i, "L") = cel.Offset(, -1)
Next cel
Next i

Set Rng1 = Nothing
Set Rng2 = Nothing
End Sub

Hope that helps.


kp

[vzachin]

hi kp,

nice and simple...thanks!


zach

[Digita]

Hi Zach,

Glad that helps. Given you have some 5000 rows of data, I amended the code to speed things up a bit. Here it goes:



Sub kTest()
Dim a, i As Long, j As Long, w(), b, x, cel
Dim Rng1 As Range, Rng2 As Range, r As Long
Set Rng2 = Range("b5", Range("b" & Rows.Count).End(xlUp))
Set Rng1 = Range("f5", Range("f" & Rows.Count).End(xlUp))
a = Rng1.Value
b = Rng2.Value
r = Application.Max(UBound(a, 1), UBound(b, 1))
ReDim w(1 To r, 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 1)) Then
x = Application.Match(a(i, 1), b, 0)
If IsError(x) Then j = j + 1: w(j, 1) = a(i, 1)
End If
Next

If j > 0 Then Range("m5").Resize(j).Value = w


For i = 5 To j + 4

For Each cel In Rng1



If cel = Range("M" & i) Then
Cells(i, "L") = cel.Offset(, -1)
Exit For ' stop iteration when found matching value

End If


Next cel



Next i


Set Rng1 = Nothing 'clear memory
Set Rng2 = Nothing
End Sub



Cheers



kp

[vzachin]

hi kp,

thanks for the update.
the code ran so quick i didn't notice much of a difference. :-)

thanks again
zach