Help with VB code to compare two columns

[Farooq Sheri]

I have written VB code to compare values in columns B and S. If a value in B
is not found in S then the text color for value in B is changed to red. The
process continues until there are no more values in B. The code is given
below:

Range("B2").Activate
Dim ctr As Integer
ctr = 0
Set rng = Range("B2")
Dim x As String
x = ActiveCell.Text
Debug.Print x

While x <> ""

Columns("S:S").Select
On Error GoTo errorhandler
Selection.Find(What:=x, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate


errorhandler:
If x <> ActiveCell.Value Then
MsgBox ("Current Value is not found")
rng = Worksheets("Sheet3").Cells(2, 2).Offset(ctr, 0).Activate
Selection.Font.ColorIndex = 3
End If

ctr = ctr + 1
rng = Worksheets("Sheet3").Cells(2, 2).Offset(ctr, 0).Activate
x = ActiveCell.Text
Wend

This is what is happening. For the first value in B not found in S the code
works okay, but for the next value not found in S, the following error is
generated "Object Variable or With block not set". How can I overcome this
problem (I even have an error handler in place). Importantly what is causing
this error.

Thanks in advance for your help.

Farooq

 

[Toppers]

Farooq,
Here is some alternative code which uses the MATCH function
to compare the two columns:

HTH

Sub Colour_ColB_Red()

Dim lastrow As Long

With Worksheets("sheet3")

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row ' <== get last row in Column B

For j = 2 To lastrow
res = Application.Match(.Cells(j, 2), .Range("S:S"), 0) ' <== Match B
with col S
If IsError(res) Then ' No match found
MsgBox ("Current Value is not found")
.Cells(j, 2).Font.ColorIndex = 3 ' <== colour B font
End If
Next j
End With
End Sub

 

[Farooq Sheri]

Thank you very much for your help. It works fine. Since I rarely use VB and
have very basic knowledge of it I would like to know the reason for my code
not working properly. Thanks once again.

Farooq

 

[kounoike]

Thank you very much for your help. It works fine. Since I rarely use VB and
have very basic knowledge of it I would like to know the reason for my code
not working properly. Thanks once again.

Resume errorhandler1 ' <= = = add this
errorhandler1: ' <= = = add this
if you just want to run your code, add two lines described above.
but this would not produce correct result, because it has some wrong codes in it.

1. Selection.Find().Activate is not valid. Find only returns a range and can't
activate
the range.
2. rng = Worksheets("Sheet3").Cells(2, 2).Offset(ctr, 0).Activate can't put a
value
expected into rng. i mean this can't set rng to range.
3. wrong error handling.

following your code, something like this would work.

Sub test1()
Worksheets("Sheet3").Range("B2").Activate
Dim ctr As Integer
Dim rng As Range, tmp As Range
ctr = 0
Set rng = Worksheets("Sheet3").Range("B2")
Dim x As String
x = ActiveCell.Text
Debug.Print x

While x <> ""
Worksheets("Sheet3").Columns("S:S").Select
On Error GoTo errorhandler
Set tmp = Selection.Find(What:=x, After:=Range("s1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
tmp.Activate
If x <> ActiveCell.Value Then
MsgBox ("Current Value is not found")
rng.Font.ColorIndex = 3
End If
nstep:
ctr = ctr + 1
Set rng = Worksheets("Sheet3").Cells(2, 2).Offset(ctr, 0)
rng.Activate
x = ActiveCell.Text
Set tmp = Nothing
Wend
Exit Sub

errorhandler:
MsgBox ("Current Value is not found")
rng.Font.ColorIndex = 3
Resume nstep
End Sub

or more simply

Sub test2()
Dim rng As Range
Dim x As String
Dim tmp As Range

With Worksheets("sheet3")
Set rng = .Range("B2")
x = rng.Text
While x <> ""
On Error Resume Next
Set tmp = .Columns("s:s").Find(What:=x, After:=Range("s1"), LookIn:=xlValues,
_
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
On Error GoTo 0
If tmp Is Nothing Then
MsgBox ("Current Value is not found")
rng.Font.ColorIndex = 3
Else
Set tmp = Nothing
End If
Set rng = rng.Offset(1, 0)
x = rng.Text
Wend
End With
End Sub

keizi