Private Sub ClearPreviousLines()

    Const LINE_FLAG As String = "#LINE#"

    Dim myLine As Shape

    For Each myLine In ActiveSheet.Shapes

        If InStr(, myLine.Name, LINE_FLAG, vbTextCompare) >  Then

            myLine.Delete

        End If

    Next

End Sub

Private Sub MarkCurrentProgress()

    Const LINE_FLAG As String = "#LINE#"

    Const RNG_MAIN_PROG As String = "B5"

    Const COL_PROGRESS As Integer =

    Const COLS_PROGRESS As Integer = 

    Dim r As Long

    Dim x As Integer, y As Integer, h As Integer

    'Mark each step progress

    For r =  To ActiveSheet.UsedRange.Rows.Count

        strPercent = CStr(Cells(r, COL_PROGRESS).Value)

        If strPercent <> "" Then

            If IsNumeric(strPercent) Then

                With Cells(r, COL_PROGRESS)

                    x = .Left + (Cells(r, COL_PROGRESS + COLS_PROGRESS).Left - .Left) * .Value

                    y = .Top

                    h = .Height

                End With

                ActiveSheet.Shapes.AddLine(x, y, x, y + h).Name = LINE_FLAG & CStr(r)

            End If

        End If

    Next r

    'Mark main progress

    Range(RNG_MAIN_PROG).Select

    With Selection

        x = .Left + .Width * Selection(, ).Value

        y = .Top

        h = .Height

    End With

    ActiveSheet.Shapes.AddLine(x, y, x, y + h).Name = LINE_FLAG & "Main"

End Sub