VBA Loop through table rows - test for value of one column - carry out action

[MrIncredible]

Hi.



I know little VBA other than bastardising recorded macros and plagiarising those found on Google searches! So please bear with me!



Problem/Need.



I have a Table called "Current"

The table has 31 columns, and the number of rows can change from week to week.



I already have a bit of VBA code that clears all the comments in the table and then goes through the table and for a number specified column names, copies the cell contents as comments into those cells in the respective column and adjust the comments box size to allow text to wrap in the comment box where there is a lot of text, and changes the comment box colour and text colour. This works fine but is very slow with over 400 rows.

Sub Regen_Comments()
With ActiveSheet.ListObjects("Current").DataBodyRange.Select

Dim rcell As Range

Dim lArea As Long[INDENT] Application.ScreenUpdating = False
  [/INDENT]
[INDENT]ActiveSheet.ListObjects("Current").DataBodyRange.ClearComments[/INDENT]
[INDENT]For Each rcell In Range("Current[Call Summary],Current[Original Problem],Current[Resolution],Current[Support Group],Current[Actions], Current[Owner], Current[Closed When], Current[Cust Notes], Current[New]")

        If rcell.Value <> "" Then
            rcell.AddComment

            rcell.Comment.Text Text:="Call Ref:  " & Cells(rcell.Row, 2) & Chr(10) & Chr(10) & Cells(rcell.Row, rcell.Column).Value

                rcell.Comment.Shape.TextFrame.AutoSize = True

                rcell.Comment.Shape.Fill.ForeColor.SchemeColor = 12

                rcell.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2

                rcell.Comment.Shape.Shadow.Visible = msoFalse[/INDENT]
[INDENT=4]If rcell.Comment.Shape.Width >= 500 Then[/INDENT]
[INDENT=2]                        lArea = rcell.Comment.Shape.Width * rcell.Comment.Shape.Height
                        rcell.Comment.Shape.Width = 500

                        rcell.Comment.Shape.Height = (lArea / 450) * 1.2[/INDENT]
[INDENT=4]End If[/INDENT]
[INDENT]
        End If

    Next

    
'One column gets a different set of text added as a comment     
For Each rcell In Range("Current[New Call Ref]")

      If rcell.Value <> "" Then

        rcell.AddComment

      rcell.Comment.Text Text:="Updated " & ChrW(&H2194) & " Notes" & Chr(10) & Cells(rcell.Row, 15)
      rcell.Comment.Shape.TextFrame.AutoSize = True[INDENT]                rcell.Comment.Shape.Fill.ForeColor.SchemeColor = 12
                rcell.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2
                rcell.Comment.Shape.Shadow.Visible = msoFalse[/INDENT]
[INDENT=4]If rcell.Comment.Shape.Width >= 500 Then[/INDENT]
[INDENT=2]                        lArea = rcell.Comment.Shape.Width * rcell.Comment.Shape.Height
                        rcell.Comment.Shape.Width = 500
                        rcell.Comment.Shape.Height = (lArea / 450) * 1.2[/INDENT]
[INDENT=4]End If[/INDENT]

      End If

      Next

    





End With
Application.ScreenUpdating = True[/INDENT]





End Sub

As I said, this works as intended, but is very inefficient because I only need to clear and add comments to columns in a row if a value of a column in the row is of a certain value.

So what I'd like to do, but can't figure it out, is to do:

Loop through the rows in the table.
Check the value on the 31st column (header name = "NEW") in the row
If the value of "NEW" is 1 or 2, then clear the comments in the row and re-create the comments as per the routine above.

In this way instead of clearing 400 rows and recreating everything, there may be only about 15 rows that need to be refreshed with recreating comments based on latest cell values.

Many thanks for any help!