macro to comment on cells based on formula's (duplicate, length, no entry)

[basil.licop]

Hi All,

I need help making a macro that will scan for duplicates, length & empty cells.

I have the sample file below that does conditional formatting but it doesnt help as much because I want to show the reason for the highlight's on a comment instead.

sample file : http://www.mediafire.com/?sharekey=2b838b5f12f1d82cd8f14848abf485dde04e75f6e8ebb871

file that might help out: http://filedb.experts-exchange.com/incoming/2008/12_w51/86630/duplicate-finder-03.xls

checks would be:
column A - duplicates and/or length should not be over 100 characters
column B - duplicates
column F - should only contain 2 comma's(or 3 keywords)
all columns - check if no entries are found(empty cells)

Please help! I'm very noobish when it comes to macro's.

Thank you very much!

 

[basil.licop]

the check for no entry part doesn't seem to work

 

[PCL]

HOOOPPPS!

Dim CheckROW As Range

It's checking when from B to J it's empty

Option Explicit
Sub ADD_COMMENT()
Dim LASTROW As Long
Dim MyRG As Range
Dim CheckROW As Range
Dim MYCELL As Object
Dim A
'=====   COLUMN  A   =====
    LASTROW = Range("A" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("A1:A" & LASTROW)
    For Each MYCELL In MyRG
'-----    DUPLICATE   --------
        A = Application.WorksheetFunction.CountIf(MyRG, MYCELL)
        If (A > 1) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Duplicate"
            End With
        End If
'-----    LENGTH  >  100   --------
        If (Len(MYCELL) > 100) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Length  >  100"
            End With
        End If
'-----    NO  ENTRY  FOUND   --------
        Set CheckROW = Range("B" & MYCELL.Row & ":" & "J" & MYCELL.Row)
        A = Application.WorksheetFunction.CountA(CheckROW)
        If (A = 0) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="No entry found"
            End With
        End If
    Next MYCELL
'=====   COLUMN  B   =====
    LASTROW = Range("B" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("B1:B" & LASTROW)
    For Each MYCELL In MyRG
'-----    DUPLICATE   --------
        A = Application.WorksheetFunction.CountIf(MyRG, MYCELL)
        If (A > 1) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Duplicate"
            End With
        End If
    Next MYCELL
    
'=====   COLUMN  F   =====
    LASTROW = Range("F" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("F1:F" & LASTROW)
    For Each MYCELL In MyRG
'-----    3  KEYS  WORDS   --------
        A = Len(MYCELL) - Len(Replace(MYCELL, ",", "")) + 1
        If (A > 3) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="3 keywords"
            End With
        End If
    Next MYCELL
End Sub

 

[basil.licop]

the "no entry" still doesnt work.. i dont know if im doing something wrong

http://www.mediafire.com/?sharekey=2b838b5f12f1d82cd8f14848abf485dde04e75f6e8ebb871

the macro's are saved on the file.

 

[PCL]

Perhaps there is some miss understanding.
If there is some data in column A and nothing for all cells in the same row from column B to J then add a comment in the cell in column A.
Is it?

 

[basil.licop]

yes, if data is entered on column a, it will mark a comment for empty entries on columns b through f if no data are found.

 

[PCL]

In your example this never happen.....!

 

[basil.licop]

In your example this never happen.....!

I just put the code you gave me. and it doesnt work.

If you see row 5 it has entries for a,d,e & f but no entries for b & c. - it should mark a comment on those empty entries with your macro right?

 

[PCL]

There was na miss understanding. A comment was added in column A when ALL othet columns were empty.
Now there is many cells without data.
See how it works.

Option Explicit
Sub ADD_COMMENT()
Dim LASTROW As Long
Dim MyRG As Range
Dim CheckROW As Range
Dim MYCELL As Object
Dim A As Long
Dim I As Long
'=====   COLUMN  A   =====
    LASTROW = Range("A" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("A1:A" & LASTROW)
    For Each MYCELL In MyRG
'-----    DUPLICATE   --------
        A = Application.WorksheetFunction.CountIf(MyRG, MYCELL)
        If (A > 1) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Duplicate"
            End With
        End If
'-----    LENGTH  >  100   --------
        If (Len(MYCELL) > 100) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Length  >  100"
            End With
        End If
'-----    NO  ENTRY  FOUND   --------
        Set CheckROW = Range("B" & MYCELL.Row & ":" & "J" & MYCELL.Row)
        A = Application.WorksheetFunction.CountA(CheckROW)
        If (A < 9) Then
            For I = 2 To 10
                If (Cells(MYCELL.Row, I) = "") Then
                    With Cells(MYCELL.Row, I)
                        .ClearComments
                        .AddComment
                        .Comment.Visible = False
                        .Comment.Text Text:="No entry found"
                    End With
                End If
            Next I
        End If
    Next MYCELL
'=====   COLUMN  B   =====
    LASTROW = Range("B" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("B1:B" & LASTROW)
    For Each MYCELL In MyRG
'-----    DUPLICATE   --------
        A = Application.WorksheetFunction.CountIf(MyRG, MYCELL)
        If (A > 1) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="Duplicate"
            End With
        End If
    Next MYCELL
    
'=====   COLUMN  F   =====
    LASTROW = Range("F" & Rows.Count).End(xlUp).Row
    Set MyRG = Range("F1:F" & LASTROW)
    For Each MYCELL In MyRG
'-----    3  KEYS  WORDS   --------
        A = Len(MYCELL) - Len(Replace(MYCELL, ",", "")) + 1
        If (A > 3) Then
            With Cells(MYCELL.Row, MYCELL.Column)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:="3 keywords"
            End With
        End If
    Next MYCELL
End Sub

 

[basil.licop]

works perfect now. you da MAN!

Thanks again!

 

[basil.licop]

one last thing, if i wanted to check both duplicate and length over 100 characters for column A - how would I do it?