Want to select cells in B1:B19 which have same value as in cell A1

[al007]

Want to select cells in B1:B19 which have same value as in cell A1
Why macro below is not working - can anybody provide an alternative



Public Sub Select()
Dim rng As Range
Dim rngFound As Range
Dim rngOut As Range
Dim sStr As String
Dim firstAdd As String

Set rng = Range("A1")
sStr = rng.Value

Set rngFound = Range("B1:B19").Find _
(What:=sStr, _
After:=rng(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)

If Not rngFound Is Nothing Then
firstAdd = rngFound.Address
Set rngOut = rngFound
End If

Do
Set rngFound = Range("B2:B19").FindNext(rngFound)
If Not rngFound Is Nothing Then
Set rngOut = Union(rngOut, rngFound)
End If
Loop While Not rngFound Is Nothing _
And rngFound.Address <> firstAdd

If Not rngOut Is Nothing Then rngOut.Select

End Sub

[gajendra_vba]

Hi,

You may try out this few lines code..mentioned as below:

Sub Search_Range()

For Each Cell In Range("b1:b19")
If Cell.Text = Range("a1").Text Then
MsgBox "Value found"
Cell.Select
End If
Next

End Sub

[Norman Jones]

Hi AL007,

> Why macro below is not working - can anybody provide an alternative

Two reasons:

(1) Select is a reserved word and should not be used as a procedure name
(2) Errors my code

Try, therefore, this revision:

'=============>>
Public Sub SelectThem()
Dim rng As Range
Dim rng2 As Range
Dim rngFound As Range
Dim rngOut As Range
Dim sStr As String
Dim firstAdd As String

Set rng = Range("A1")
Set rng2 = Range("B1:B19")
sStr = rng.Value

Set rngFound = rng2.Find _
(What:=sStr, _
After:=rng2(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)

If Not rngFound Is Nothing Then
firstAdd = rngFound.Address
Set rngOut = rngFound

Do
Set rngFound = Range("B2:B19").FindNext(rngFound)
If Not rngFound Is Nothing Then
Set rngOut = Union(rngOut, rngFound)
End If
Loop While Not rngFound Is Nothing _
And rngFound.Address <> firstAdd
End If

If Not rngOut Is Nothing Then rngOut.Select

End Sub
'<<=============

BTW, it is more efficient, polite, and in accordance with netiquette, to
remain within the original thread.

---
Regards,
Norman



"al007" <[email protected]> wrote in message
news:[email protected]...
> Want to select cells in B1:B19 which have same value as in cell A1
> Why macro below is not working - can anybody provide an alternative
>
>
>
> Public Sub Select()
> Dim rng As Range
> Dim rngFound As Range
> Dim rngOut As Range
> Dim sStr As String
> Dim firstAdd As String
>
> Set rng = Range("A1")
> sStr = rng.Value
>
> Set rngFound = Range("B1:B19").Find _
> (What:=sStr, _
> After:=rng(1), _
> LookIn:=xlValues, _
> LookAt:=xlPart, _
> SearchOrder:=xlByColumns, _
> SearchDirection:=xlNext)
>
> If Not rngFound Is Nothing Then
> firstAdd = rngFound.Address
> Set rngOut = rngFound
> End If
>
> Do
> Set rngFound = Range("B2:B19").FindNext(rngFound)
> If Not rngFound Is Nothing Then
> Set rngOut = Union(rngOut, rngFound)
> End If
> Loop While Not rngFound Is Nothing _
> And rngFound.Address <> firstAdd
>
> If Not rngOut Is Nothing Then rngOut.Select
>
> End Sub
>