finder

[aoc]

hi

I attached a file. numbers in sheet 2 will be checked if they are in sheet one.
it is not important to have same format, it is enugh to find correct number in the searched sheet 1. if found, it will write ok next to each cell in sheet one.


for example I want to search 0532 612 23 61 in sheet 2 in sheet 1, if it is in cell A2 in sheet 1 ( A2 value 905326122361 or 05326122361 ) it will write OK. so it is a character comparing, can it be with a formula or code.

[Aussiebear]

I take it that any excess characters will always be to the left of the core set of characters?

[rbrhodes]

Ho aoc,

See attached. Code marked '//Begin optional ... //End optional can be deleted.

[aoc]

DEAR RBRHODES

thank you very much for the code. my original list contains same phone numbers as well. I mean that it will write ok to all 05324025310 not only one time. assume there are 145000 phone numbers, 1300 of them are 05324025310, so I will see 1300 ok written. Can you please revise it

[mdmackillop]

Building on DR's code

Option Explicit
Sub GetNum()
Dim cel As Range
Dim rng As Range
Dim FindRow As Long
Dim Lastrow As Long
Dim GetVal As String
Dim wsNumFind As Worksheet
Dim wsNumFound As Worksheet
Dim FirstAddress As String
Dim c As Range
Dim x As Long
'Sheets
Set wsNumFind = Sheet2
Set wsNumFound = Sheet1
With wsNumFind
'Clear old
wsNumFound.Columns("B:B").ClearContents
.Columns("B:B").ClearContents
'Get last row of data to search for
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
'Set range of data to search for
Set rng = .Range("A1:A" & Lastrow)
'Do all
For Each cel In rng
x = 0
'Get cell value w/o spaces
GetVal = Replace(cel, " ", "")
'Allow not found error
On Error Resume Next
With Worksheets("Sheet1").Columns(1)
Set c = .Find(GetVal, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
x = x + 1
c.Offset(, 1) = "OK" & " - " & cel
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If x > 0 Then cel.Offset(0, 1) = "Found " & x & " times"
FirstAddress = ""
Else
cel.Offset(0, 1) = "Not found"
End If
End With
Next cel
End With

Set cel = Nothing
Set rng = Nothing
Set wsNumFind = Nothing
Set wsNumFound = Nothing
End Sub

[rbrhodes]

[EDIT] "By George, I think MD got it" the OP wants it to post OK 1300 times...

[aoc]

hi mdmackillop (http://www.vbaexpress.com/forum/member.php?u=87)

there is something wrong with your code.

can you check the attached file and test ? it is enough to write " ok " in sheet 1 column B and "found" in sheet 2 column B

[mdmackillop]

Works OK for me when I put my code in your workbook.

[rbrhodes]

...not 'something wrong', per se...

I think (tentatively) that the OP wants just "OK" on Sheet1 and just "Found" on Sheet2?

Is this what you need:


Option Explicit
Sub GetNum()
Dim cel As Range
Dim rng As Range
Dim FindRow As Long
Dim Lastrow As Long
Dim GetVal As String
Dim wsNumFind As Worksheet
Dim wsNumFound As Worksheet
Dim FirstAddress As String
Dim c As Range
Dim x As Long
'Sheets
Set wsNumFind = Sheet2
Set wsNumFound = Sheet1
With wsNumFind
'Clear old
wsNumFound.Columns("B:B").ClearContents
.Columns("B:B").ClearContents
'Get last row of data to search for
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
'Set range of data to search for
Set rng = .Range("A1:A" & Lastrow)
'Do all
For Each cel In rng
x = 0
'Get cell value w/o spaces
GetVal = Replace(cel, " ", "")
'Allow not found error
On Error Resume Next
With Worksheets("Sheet1").Columns(1)
Set c = .Find(GetVal, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
x = x + 1
'//OK only
c.Offset(, 1) = "OK"
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
'//Found only
If x > 0 Then cel.Offset(0, 1) = "Found"
FirstAddress = ""
End If
End With
Next cel
End With

Set cel = Nothing
Set rng = Nothing
Set wsNumFind = Nothing
Set wsNumFound = Nothing
End Sub

[mdmackillop]

Hmmmmm :dunno
Hopefully you've got it right. I wonder though, without the additional information for testing purposes, how one checks 4770 values written into 83000 rows. In my experience, not checking carefully will lead quickly to disaster.

Osman
o DR has kindly adjusted the code. I'd expect you to attempt to fix such a simple issue. We are here to assist, not simply to provide solutions. Please refer to our FAQ.