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!

 

[PCL]

Not sure it's what you need, here column A and B treatment.

Option Explicit
Sub ADD_COMMENT()
Dim LASTROW As Long
Dim MyRG 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
    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
    
End Sub

 

[basil.licop]

Thanks PCL but it doesnt work. it gave me a "For without Next" error

 

[PCL]

HOOOUPS!
How that could be possible...
Just add

    Next MyCELL

before

End Sub

Please confim treatment to do for other columns if this one is correct.

 

[basil.licop]

perfect! works. but how about column F? pretty much all there is to do is to count the number of comma's. if its over 2 then it should comment "too many keywords"

 

[PCL]

Here we are.
Could you give more datail about

all columns - check if no entries are found(empty cells)

Option Explicit
Sub ADD_COMMENT()
Dim LASTROW As Long
Dim MyRG 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
    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]

Well if an entry is given for column A and no entry is found on columns B thru J(on the same row) it should comment "No entry found".

Btw, your awesome! thanks a lot for your help!

 

[PCL]

Just add next part of code

'-----    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

After

'-----    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

Of course the check is the winner:
If in cell column A there is more than 100 characters and there is nothing from column B to J, the last comment will be recorded.

 

[basil.licop]

It throws an error on CheckROW - variable not defined

 

[basil.licop]

It throws an error on CheckROW - variable not defined

just added Dim CheckROW As Object at the top