'
' The purpose of this macro is to remove bookmark comment within the first cell
' of a line. Each first cell will be checked whether it starts with "====== Bookmark Info ======"
' and if it does the Bookmark Info will be removed.
' Any text behind the second "====== Bookmark Info ======" will be retained.
' In case the second part is missing we will only remove the leading ""====== Bookmark Info ======" component
'
' Macro created 14-06-2007 by Bob Becker Hof (HP)
' Tested with Excel 2003 and EVE 2.30 xls output format
' If the length of the file is huge the progress indicator at the top get an overflow (>200 characters) and get into the debugger.
'   We now check the length of the variable and if it exceeds 200 we take the last 197 characters and put three dots at the start.
'

Sub Comment_Bookmark_lines_Unmarking()

Dim crow As Long
Dim ccol As Long
Dim lasrow As Long
Dim lascol As Long
Dim trow As Long
Dim newrow As Boolean
Dim csname As String
Dim prgname As String

Dim msg As String
Dim Style As Long
Dim Title As String
Dim Response As Long

Dim stepsize As Double
Dim steprows As Integer
Dim stepperc As String
Dim currentcaption As String

Dim MultiRange As Range
Dim hidden_rows_behind_lasrow As Long
    
Dim currentcomment As String
Dim commenttextstart As String
Dim commenttextend As String
Dim cmttext As String
Dim commentcolumn As Integer
Dim rng As Range
Dim commentendpos As Integer

    Title = "Comment_Bookmark_lines_Unmarking"          ' Define title.
    prgname = "%" + Title + ": "

    crow = ActiveCell.Row
    ccol = ActiveCell.Column
    lasrow = ActiveCell.SpecialCells(xlLastCell).Row
    lascol = ActiveCell.SpecialCells(xlLastCell).Column

    commenttextstart = "====== Bookmark Info ======"
    commenttextend = commenttextstart
    commentcolumn = 1

'
' By default the xlLastCell.row funtion returns the last visible row
' But there might be more rows below it which are hidden so loop down until we hit a row which is NOT hidden
' Lets assume that 650000 is the maximum row number possible...
'
''    Debug.Print "Current Lasrow: " & Str(lasrow)
    For hidden_rows_behind_lasrow = lasrow To 650000 Step 1
        If Not (Range(Cells(hidden_rows_behind_lasrow + 1, 1).Address).EntireRow.Hidden) Then
            lasrow = hidden_rows_behind_lasrow
''            Debug.Print "New Lasrow    : " & Str(lasrow)
            Exit For
        End If
    Next

    csname = ActiveSheet.Name

'
' If the current row is bookmarked ask whether we would like to clear the current line
' If so just clear this line
' When the current row is NOT bookmarked ask whether we would like to clear the entire sheet
' If not exit
'
    Set rng = ActiveSheet.Cells(crow, commentcolumn)
    If Not (rng.Comment Is Nothing) Then
        currentcomment = rng.Comment.Text
        If Left(currentcomment, Len(commenttextstart)) = commenttextstart Then
            msg = "Are you sure you want to remove the bookmark for the CURRENT line?"    ' Define message.
            Style = vbYesNo + vbWarning + vbDefaultButton2      ' Define buttons.
            Response = MsgBox(msg, Style, Title)
            If Response = vbNo Then                             ' User chose No.
                GoTo Finish
            End If
        
            currentcomment = Right(currentcomment, Len(currentcomment) - Len(commenttextstart))
            commentendpos = InStr(1, currentcomment, commenttextend)
            If commentendpos <> 0 Then
                commentendpos = commentendpos + Len(commenttextend) - 1
                If (commentendpos < Len(currentcomment)) Then
                    currentcomment = Right(currentcomment, Len(currentcomment) - commentendpos)
                Else
                    currentcomment = ""
                End If
                If Left(currentcomment, 1) = Chr(10) Then
                    currentcomment = Right(currentcomment, Len(currentcomment) - 1)
                End If
            End If
                
            If Len(currentcomment) <> 0 Then
                rng.ClearComments
                rng.AddComment Text:=currentcomment
                rng.Comment.Shape.Placement = xlMoveAndSize
            Else
                rng.Comment.Delete
            End If
            GoTo Finish
        End If
    End If
    
    msg = "Are you sure you want to remove ALL bookmarks?"    ' Define message.
    Style = vbYesNo + vbWarning + vbDefaultButton2      ' Define buttons.
    Response = MsgBox(msg, Style, Title)
    If Response = vbNo Then                            ' User chose No.
        GoTo Finish
    End If

' Temporarily stop screen updates to speed up the process
    Application.ScreenUpdating = False
    currentcaption = ActiveWorkbook.Windows(1).Caption    ' Save current Window Caption

' We would like to see how we are progressing even though we disable the screen updates...
    stepsize = lasrow / 10                           ' We display info each 10th time
    steprows = 0
    
    For trow = lasrow To 1 Step -1
       
        steprows = steprows + 1
'
' Do we have to show where we are?
'
        If (steprows > stepsize) Then
            stepperc = currentcaption & " ==> Comment_Bookmark_lines_Unmarking progress... " & Int((lasrow - trow) / lasrow * 100) & " %"
            if len(stepperc) > 200 Then
            	stepperc = "..." & right(stepperc,197)
            End If
            Debug.Print stepperc
            Application.ScreenUpdating = True
            ActiveWorkbook.Windows(1).Caption = stepperc
            Application.ScreenUpdating = False
            steprows = 0                                    ' Count our steps again for our next intermediate result
        End If

        Set rng = ActiveSheet.Cells(trow, commentcolumn)
        If Not (rng.Comment Is Nothing) Then
            currentcomment = rng.Comment.Text
''            Debug.Print prgname & "Cell at row " & crow & " column 1 has comment/bookmark set to " & Chr(10) & currentcomment & Chr(10) & "within worksheet " & csname
            If Left(currentcomment, Len(commenttextstart)) = commenttextstart Then
                currentcomment = Right(currentcomment, Len(currentcomment) - Len(commenttextstart))
                commentendpos = InStr(1, currentcomment, commenttextend)
                If commentendpos <> 0 Then
                    commentendpos = commentendpos + Len(commenttextend) - 1
                    If (commentendpos < Len(currentcomment)) Then
                        currentcomment = Right(currentcomment, Len(currentcomment) - commentendpos)
                    Else
                        currentcomment = ""
                    End If
                    If Left(currentcomment, 1) = Chr(10) Then
                        currentcomment = Right(currentcomment, Len(currentcomment) - 1)
                    End If
                End If
                
                If Len(currentcomment) <> 0 Then
                    rng.ClearComments
                    rng.AddComment Text:=currentcomment
                    rng.Comment.Shape.Placement = xlMoveAndSize
                Else
                    rng.Comment.Delete
                End If
            
            End If
        End If
    Next

' Enable screen updates and original windows caption again
    ActiveWorkbook.Windows(1).Caption = currentcaption
    Application.ScreenUpdating = True
    
    Cells(crow, ccol).Select
    
Finish:
    
End Sub
