Searching a sheet for numbers with 7 digits in length, and appling for and if statements.

[mnut1]

Hello,
I've got myself a little stuck!! Any help would be very much appriciated!

I am using excel 2003, Please see the linked example workbook below:
https://app.box.com/s/wkv1yn5040t3wolorz8u

I have a workbook with two sheets, the first is a random splattering of words and numbers the second is a list of numbers with a alpha numeric id for each.

I need a macro to search for a 7 digit number in the first sheet.
Once found look at the list of numbers in the second sheet and if the number appears more than once;
to highlight the cell in the first sheet blue, and add a comment containing the alpha numeric id of the number in the second sheet.
Then loop to find the next 7 digit number in the first sheet, etc.

I have got a macro that finds the duplicates and lables from a list of numbers within the same sheet but i am have trouble with the first part the "search" bit.
The macros for tester (below) and reset are in module 1.

Sheets("Sheet2").Select
    For MY_WORDS = 1 To Range("F3").End(xlDown).Row
        MY_WORD = Range("F" & MY_WORDS).Value
        For MY_ROWS = 1 To Range("A3").End(xlDown).Row
            If Range("A" & MY_ROWS).Value = MY_WORD Then
                MY_COUNT = MY_COUNT + 1
                MY_COMMENT = MY_COMMENT & Range("C" & MY_ROWS).Value _
                & Range("D" & MY_ROWS).Value & Chr(10)
            End If
        Next MY_ROWS
        If MY_COUNT > 1 Then
            Range("F" & MY_WORDS).AddComment
            Range("F" & MY_WORDS).Comment.Text Text:=MY_COMMENT
            Range("F" & MY_WORDS).Comment.Shape.TextFrame.AutoSize = True
            Range("F" & MY_WORDS).Interior.Color = vbBlue
        End If
        MY_COMMENT = ""
        MY_COUNT = 0
    Next MY_WORDS

Thanks,

Mike

 

[wist]

hey man,

not sure if this code will work in Excel 2003 (I'm using 2010 here) but if I got what you were saying correctly then this macro should do the trick

Sub checking()

On Error Resume Next
Sheets("Sheet2").Activate

b = 1
c = Application.CountA(Range("A:A"))

Do Until b > c
Set x = Worksheets("Sheet1").Range("A1:M13").Find(Sheets("Sheet2").Cells(b, 1).Value, lookat:=xlPart)

If Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Sheets("Sheet2").Cells(b, 1)) > 1 Then
x.Interior.Color = vbBlue
    Set Z = x.comment
            If Z Is Nothing Then
                x.AddComment.Text Text:=Cells(b, 3) & Cells(b, 4)
            Else
                x.comment.Text x.comment.Text & vbLf & Cells(b, 3) & Cells(b, 4)
            End If
End If

b = b + 1

Loop

Sheets("Sheet1").Activate
End Sub

worked for me!

 

[mnut1]

Hi wist, thanks for your time, im just putting it in now.

 

[mnut1]

Wist you are a super star!!!! Thanks ever so much!!

 

[wist]

glad i could help