Runtime error -2147417848 (80010108)

danners430

New Member
Joined
Aug 3, 2017
Messages
45
Afternoon all,

I've got a workbook which uses multiple userforms to control data, but have discovered that in one particular userform I get the error code -2147417848 (80010108) (Automation Error: The object invoked has disconnected from its clients) when I hit ESC.

Unfortunately I have no idea where the issue lies in the code, as debug mode only takes me back to the Userform.Show command, and when I try stepping through using F8, it complains that it can't show the userform as it's already visible :(

I've tried stepping through the entire process of loading the userform and found nothing; and when hitting ESC no code actually runs - the error is the first thing to occur.

This error only appears in one form, I've tested the others and they're all fine with ESC as a means of "emergency stop".

The final twist to this is that following the error, I can't close excel... When I attempt to close the program, it seemingly gets stuck in a loop somehow and refuses to shut down - I have no workbook.close or worksheet.deactivate etc. events created... I end up having to kill the program using task manager.

Anyone got any suggestions? I would attach the userform if I could, but no idea how :)



Userform code:

Code:
Option Explicit
Dim TabCheck As Boolean
Dim LastRowA As Long
Dim TitleArr() As Variant
Dim LinkArr() As Variant
Dim LastRowOldA As Long
Dim LastRowNewA As Long
Dim LastRowNewB As Long
Dim rngA As String
Dim rngB As String




'Page 1






Private Sub CommandButtonCanc_Click()


Me.Hide


End Sub


Private Sub CommandButtonOK_Click()


Call NewRow


Me.Hide


End Sub


Private Sub ListBoxOwn_Change()


Call OKEnable


End Sub


Private Sub OptionButton1_Click()


Call OKEnable


End Sub


Private Sub OptionButton2_Click()


Call OKEnable


End Sub


Private Sub OptionButton3_Click()


Call OKEnable


End Sub






Private Sub P2_ComboBoxID_Change()


If EnableEvents = False Then Exit Sub


Call ComboBoxIDChange(P2_ComboBoxID, P2_ComboBoxID.ListIndex)


End Sub


Private Sub P2_ListBoxOwn_Change()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub


Private Sub P2_TextBoxCust_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P2_TextBoxCust.Text, X, Y, P2_TextBoxCust)
    End If
End Sub


Private Sub P2_TextBoxDesc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P2_TextBoxDesc.Text, X, Y, P2_TextBoxDesc)
    End If
End Sub


Private Sub P3_ComboBoxID_Change()


If EnableEvents = False Then Exit Sub


Call ComboBoxIDChange(P3_ComboBoxID, P3_ComboBoxID.ListIndex)


End Sub


Private Sub P3_CommandButtonRelDocMan_Click()


RelDocMan.Show


Call AcceptID


End Sub


Private Sub P3_TextBoxRelDocLink1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocLink1.Text, X, Y, P3_TextBoxRelDocLink1)
    End If
End Sub


Private Sub P3_TextBoxRelDocLink2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocLink2.Text, X, Y, P3_TextBoxRelDocLink2)
    End If
End Sub


Private Sub P3_TextBoxRelDocName1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)


    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocName1.Text, X, Y, P3_TextBoxRelDocName1)
    End If


End Sub


Private Sub P3_TextBoxRelDocName2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocName2.Text, X, Y, P3_TextBoxRelDocName2)
    End If
End Sub


Private Sub P4_ComboBoxID_Change()


If EnableEvents = False Then Exit Sub


Call ComboBoxIDChange(P4_ComboBoxID, P4_ComboBoxID.ListIndex)


End Sub


Private Sub P4_CommandButtonCM_Click()


CM.Show


Call AcceptID


End Sub


Private Sub P4_TextBoxCom_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P4_TextBoxCom.Text, X, Y, P4_TextBoxCom)
    End If
End Sub


Private Sub P5_ComboBoxID_Change()


If EnableEvents = False Then Exit Sub


Call ComboBoxIDChange(P5_ComboBoxID, P5_ComboBoxID.ListIndex)


End Sub


Private Sub P6_ComboBoxID_Change()


If EnableEvents = False Then Exit Sub


Call ComboBoxIDChange(P6_ComboBoxID, P6_ComboBoxID.ListIndex)


End Sub


Private Sub P6_CommandButtonCanc_Click()


Me.Hide


End Sub


Private Sub P6_CommandButtonDel_Click()


Answer = MsgBox("Are you sure you want to delete task no. " & ID & "?", vbYesNo + vbQuestion, "Delete Task")
If Answer = vbNo Then Exit Sub


Call DeleteRow


Me.Hide


End Sub


Private Sub TextBoxCust_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, TextBoxCust.Text, X, Y, TextBoxCust)
    End If
End Sub


Private Sub TextBoxDesc_Change()


Call OKEnable


End Sub








'Page 2


Private Sub P2_CommandButtonCanc_Click()


If EnableEvents = False Then Exit Sub


Me.Hide


End Sub


Private Sub P2_CommandButtonOK_Click()


If EnableEvents = False Then Exit Sub


Call P2_OK


Call AcceptID


End Sub




Private Sub P2_OptionButton1_Click()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub


Private Sub P2_OptionButton2_Change()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub


Private Sub P2_OptionButton3_Change()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub




Private Sub P2_TextBoxCust_Change()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub


Private Sub P2_TextBoxDesc_Change()


If EnableEvents = False Then Exit Sub


Call P2_OKEnable


End Sub












'Page 3






Private Sub P3_CommandButtonCanc_Click()


Me.Hide


End Sub


Private Sub P3_TextBoxRelDocName1_Change()


If EnableEvents = False Then Exit Sub


If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName2.Visible = False
    P3_TextBoxRelDocLink2.Visible = False
    Exit Sub
Else
    P3_TextBoxRelDocName2.Visible = True
    P3_TextBoxRelDocLink2.Visible = True


End If


If P3_OkEnable = False Then P3_CommandButtonOK.Enabled = False
If P3_OkEnable = True Then P3_CommandButtonOK.Enabled = True


End Sub


Private Sub P3_TextBoxRelDocLink1_Change()


If EnableEvents = False Then Exit Sub


If P3_OkEnable = False Then
    P3_CommandButtonOK.Enabled = False
    P3_CommandButtonCanc.Default = True
Else
    P3_CommandButtonOK.Enabled = True
    P3_CommandButtonOK.Default = True
End If


End Sub


Private Sub P3_TextBoxRelDocName1_Enter()


If P3_TextBoxRelDocName1 <> "Name" Then
    Exit Sub
Else
    P3_TextBoxRelDocName1.Value = ""
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If


End Sub


Private Sub P3_TextBoxRelDocName1_Exit(ByVal Cancel As MSForms.ReturnBoolean)


If P3_TextBoxRelDocName1.Value <> "" And P3_TextBoxRelDocName1 <> "Name" Then
    Sheet3.Cells(RelDoc1Counter, 1) = P3_TextBoxRelDocName1
    Exit Sub
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
End If


End Sub


Private Sub P3_TextBoxRelDocLink1_Enter()


If Not P3_TextBoxRelDocLink1 = "Link" Then
Exit Sub
Else


P3_TextBoxRelDocLink1.Value = ""
P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)


End If


End Sub


Private Sub P3_TextBoxRelDocLink1_Exit(ByVal Cancel As MSForms.ReturnBoolean)


If P3_TextBoxRelDocLink1.Value <> "" And P3_TextBoxRelDocLink1 <> "Link" Then


Sheet3.Cells(RelDoc1Counter, 2) = P3_TextBoxRelDocLink1


Else
P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
P3_TextBoxRelDocLink1 = "Link"


End If


End Sub


Private Sub P3_TextBoxRelDocName2_Enter()


If P3_TextBoxRelDocName2 <> "Name" Then
    Exit Sub
Else
    P3_TextBoxRelDocName2.Value = ""
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If


TabCheck = True


End Sub


Private Sub P3_TextBoxRelDocName2_Exit(ByVal Cancel As MSForms.ReturnBoolean)


If P3_TextBoxRelDocName2.Value <> "" And P3_TextBoxRelDocName2 <> "Name" Then
    Sheet3.Cells(RelDoc2Counter, 1) = P3_TextBoxRelDocName2
    Exit Sub
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
End If


End Sub


Private Sub P3_TextBoxRelDocLink2_Enter()


If P3_TextBoxRelDocLink2 <> "Link" Then
    Exit Sub
Else
    P3_TextBoxRelDocLink2.Value = ""
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If


End Sub


Private Sub P3_TextBoxRelDocLink2_Exit(ByVal Cancel As MSForms.ReturnBoolean)


If P3_TextBoxRelDocLink2.Value <> "" And P3_TextBoxRelDocLink2 <> "Link" Then
    Sheet3.Cells(RelDoc2Counter, 2) = P3_TextBoxRelDocLink2
    Call P3_FilledChecker
    Exit Sub
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
End If


End Sub


Private Sub P3_TextBoxRelDocLink2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)


If TabCheck = False Then Exit Sub


If KeyCode = vbKeyTab And P3_TextBoxRelDocName2 <> "Name" Then
    P3_TextBoxRelDocName2.SetFocus
    SendKeys "{BS}", True
End If


End Sub


Private Sub P3_CommandButtonRelDocUp_Click()


P3_TextBoxRelDocName1 = Sheet3.Cells(RelDoc1Counter - 1, 1)
P3_TextBoxRelDocLink1 = Sheet3.Cells(RelDoc1Counter - 1, 2)
P3_TextBoxRelDocName2 = Sheet3.Cells(RelDoc2Counter - 1, 1)
P3_TextBoxRelDocLink2 = Sheet3.Cells(RelDoc2Counter - 1, 2)


RelDoc1Counter = RelDoc1Counter - 1
RelDoc2Counter = RelDoc2Counter - 1


If P3ComButUp = True Then
    P3_CommandButtonRelDocUp.Visible = True
Else
    P3_CommandButtonRelDocUp.Visible = False
End If


If P3ComButDown = True Then
    P3_CommandButtonRelDocDown.Visible = True
Else
    P3_CommandButtonRelDocDown.Visible = False
End If


If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocLink1 = "" Or P3_TextBoxRelDocLink1 = "Link" Then
    P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink1 = "Link"
Else
    P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocName2 = "" Or P3_TextBoxRelDocName2 = "Name" Then
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocLink2 = "" Or P3_TextBoxRelDocLink2 = "Link" Then
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If


End Sub


Private Sub P3_CommandButtonRelDocDown_Click()


P3_TextBoxRelDocName1 = Sheet3.Cells(RelDoc1Counter + 1, 1)
P3_TextBoxRelDocLink1 = Sheet3.Cells(RelDoc1Counter + 1, 2)
P3_TextBoxRelDocName2 = Sheet3.Cells(RelDoc2Counter + 1, 1)
P3_TextBoxRelDocLink2 = Sheet3.Cells(RelDoc2Counter + 1, 2)


RelDoc1Counter = RelDoc1Counter + 1
RelDoc2Counter = RelDoc2Counter + 1


If P3ComButUp = True Then
    P3_CommandButtonRelDocUp.Visible = True
Else
    P3_CommandButtonRelDocUp.Visible = False
End If


If P3ComButDown = True Then
    P3_CommandButtonRelDocDown.Visible = True
Else
    P3_CommandButtonRelDocDown.Visible = False
End If


If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocLink1 = "" Or P3_TextBoxRelDocLink1 = "Link" Then
    P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink1 = "Link"
Else
    P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocName2 = "" Or P3_TextBoxRelDocName2 = "Name" Then
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If


If P3_TextBoxRelDocLink2 = "" Or P3_TextBoxRelDocLink2 = "Link" Then
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If


End Sub




Private Sub P3_CommandButtonOK_Click()


LastRowA = LastRow(Sheet3, 1)
    
If Sheets(IDstr).Cells(1, 1) = "" Then
    LastRowOldA = 0
Else
    LastRowOldA = LastRow(Sheets(IDstr), 1)
End If


TitleArr = Sheet3.Range("A1:A1000")
LinkArr = Sheet3.Range("B1:B1000")


rngA = "A" & LastRowOldA + 1 & ":A1000"
rngB = "B" & LastRowOldA + 1 & ":B1000"


Sheets(IDstr).Range(rngA) = TitleArr
Sheets(IDstr).Range(rngB) = LinkArr


LastRowNewA = LastRow(Sheets(IDstr), 1)
LastRowNewB = LastRow(Sheets(IDstr), 2)


Sheet3.Range("A:B") = ""


If LastRowNewA = 1 And Sheets(IDstr).Cells(1, 1) = "" Then
    Sheet1.Cells(TargetRow, 10) = 0
Else
    Sheet1.Cells(TargetRow, 10) = LastRowNewA
End If


Call AcceptID


End Sub


Private Function P3_OkEnable()


If P3_TextBoxRelDocName1 = "" And P3_TextBoxRelDocLink1 = "" Then
P3_OkEnable = False
Else
P3_OkEnable = True
End If


End Function








'Page 4




Private Sub P4_CommandButtonCanc_Click()


Me.Hide


End Sub


Private Sub P4_TextBoxCom_Change()


If EnableEvents = False Then Exit Sub


Call P4_OkEnable


End Sub


Private Sub P4_OkEnable()


If Not P4_TextBoxCom = "" Then
    P4_CommandButtonOK.Enabled = True
    P4_CommandButtonOK.Default = True
Else
    P4_CommandButtonOK.Enabled = False
    P4_CommandButtonCanc.Default = True
End If


End Sub


Private Sub P4_CommandButtonOK_Click()


Call P4_OK


Call AcceptID


End Sub








'Page 5






Private Sub P5_CheckBoxComp_Click()


Call p5_OKEnable


End Sub


Private Sub P5_CommandButtonCanc_Click()


Me.Hide


End Sub








Private Sub P5_CommandButtonOK_Click()


If P5_CheckBoxComp = False Then
    Call Uncomplete
Else
    Call Complete
End If


Me.Hide


End Sub


Private Sub p5_OKEnable()


If (Sheet1.Cells(TargetRow, 8) = 0 And P5_CheckBoxComp = False) Or (Sheet1.Cells(TargetRow, 8) = 1 And P5_CheckBoxComp = True) Then
    P5_CommandButtonOK.Enabled = False
Else
    P5_CommandButtonOK.Enabled = True
End If


End Sub


Private Sub TextBoxDesc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, TextBoxDesc.Text, X, Y, TextBoxDesc)
    End If
End Sub


Private Sub UserForm_Activate()


RDMID = False
CMID = False


Sheet1.Activate


If OpButSel = True Then


    Call LoadIDs
    Call AcceptID


    RelDoc1Counter = 1
    RelDoc2Counter = 2
    
    With Me.MultiPage1
        .Pages(0).Visible = False
        .Pages(1).Visible = True
        .Pages(2).Visible = True
        .Pages(3).Visible = True
        .Pages(4).Visible = True
        If Manager = True Then .Pages(5).Visible = True
    End With
    
    If Comp = True Then Me.MultiPage1.Value = 4
    If CMActivate = True Then Me.MultiPage1.Value = 3
    If RelDocSelect = True Then Me.MultiPage1.Value = 2
    
    Comp = False
    CMActivate = False
    RelDocSelect = False


Else


    With Me.MultiPage1
        .Pages(0).Visible = True
        .Pages(1).Visible = False
        .Pages(2).Visible = False
        .Pages(3).Visible = False
        .Pages(4).Visible = False
        .Pages(5).Visible = False
    End With
    
    RDMID = False
    CMID = False


End If


End Sub


Private Sub MultiPage1_Click(ByVal Index As Long)


Select Case MultiPage1.SelectedItem.Name
    Case "Page1": Call P1Switch
    Case "Page2": Call P2Switch
    Case "Page3": Call P3Switch
    Case "Page4": Call P4Switch
    Case "Page5": Call P5Switch
    Case "Page6": Call P6Switch
End Select


End Sub


Private Sub P1Switch()






End Sub


Private Sub P2Switch()


EditTasks.Height = 280


End Sub


Private Sub P3Switch()


EditTasks.Height = 240


End Sub


Private Sub P4Switch()


EditTasks.Height = 240


End Sub


Private Sub P5Switch()


EditTasks.Height = 240


End Sub


Private Sub P6Switch()


EditTasks.Height = 280


End Sub






Private Sub UserForm_Initialize()


    With EditTasks
        .Top = Application.Top + 125
        .Left = Application.Left + 25
    End With
    
    Call UpdateOwn


End Sub


Private Sub UserForm_Terminate()


Call HideNewTask


End Sub

Module "EditTasks_Button":

Code:
Option Explicit

Dim Button As OptionButton


Sub TaskChange()


For Each Button In Sheet1.OptionButtons
    If Button.Value = 1 Then
    OpButSel = True
    End If
    Next Button
    
    Sheet1.Unprotect
    
    If OpButSel = True Then
    Sheet1.Buttons("Tasks").Caption = "Edit Task"
    Else
    Sheet1.Buttons("Tasks").Caption = "New Task"
    End If
    
Dim UIOnly As Variant
UIOnly = True


Sheet1.Protect userinterfaceonly:=UIOnly


Call HideNewTask


End Sub


Sub HideNewTask()


With Sheet1


    If .Buttons("Tasks").Caption = "New Task" And .Buttons("Hide Completed").Visible = False Then
        .Buttons("Tasks").Visible = False
    ElseIf .Buttons("Tasks").Caption = "Edit Task" Then
        .Buttons("Tasks").Visible = True
    ElseIf .Buttons("Tasks").Caption = "New Task" And .Buttons("Hide Completed").Visible = True Then
        .Buttons("Tasks").Visible = True
    End If


End With


End Sub

Module "EditTasks_GlobalFunctions":

Code:
Option Explicit
Dim cntrl As Control


Sub AcceptID()


EnableEvents = False


IDstr = ID


TargetRow = Application.Match(ID, Sheet1.Range("B1:B10000"), 0)


If IsNumeric(TargetRow) = False Then
    MsgBox "Job not found."
    Call LoadIDs
    Exit Sub
End If


With EditTasks


    Dim CBB() As String
    ReDim CBB(0 To .P2_ComboBoxID.ListCount - 1) As String
    Dim CBBi As Integer
    Dim CBBs As ComboBox
    
    For i = 0 To UBound(CBB)
        CBB(i) = .P2_ComboBoxID.List(i)
    Next i
    CBBi = IsInArray(ID & " - " & Sheet1.Cells(TargetRow, "C"), CBB) - 1
    
    .P2_ComboBoxID.ListIndex = CBBi
    .P3_ComboBoxID.ListIndex = CBBi
    .P4_ComboBoxID.ListIndex = CBBi
    .P5_ComboBoxID.ListIndex = CBBi
    .P6_ComboBoxID.ListIndex = CBBi
    
End With


Call EditTaskLoad
Call RelDocLoad
Call CommentsLoad
Call Completi******


Select Case Application.UserName
Case Sheet2.Cells(31, 2), Sheet2.Cells(32, 2), Sheet2.Cells(33, 2), Sheet2.Cells(34, 2), Sheet2.Cells(35, 2), Sheet2.Cells(36, 2), Sheet2.Cells(37, 2), Sheet2.Cells(38, 2), Sheet2.Cells(39, 2), Sheet2.Cells(40, 2), Sheet2.Cells(41, 2), Sheet2.Cells(42, 2), Sheet2.Cells(43, 2), Sheet2.Cells(44, 2), Sheet2.Cells(45, 2), Sheet2.Cells(46, 2), Sheet2.Cells(47, 2), Sheet2.Cells(48, 2), Sheet2.Cells(49, 2), Sheet2.Cells(50, 2), Sheet2.Cells(51, 2), Sheet2.Cells(52, 2), Sheet2.Cells(53, 2), Sheet2.Cells(54, 2), Sheet2.Cells(55, 2), Sheet2.Cells(56, 2), Sheet2.Cells(57, 2)
    Manager = True
Case Else
    Manager = False
End Select


If Manager = True Then Call DeleteLoad


EnableEvents = True


End Sub


Sub UpdateDur()


EnableEvents = False


With EditTasks


    .OptionButton1.Caption = Sheet2.Cells(2, 3)
    .OptionButton2.Caption = Sheet2.Cells(2, 4)
    .OptionButton3.Caption = Sheet2.Cells(2, 5)
    .P2_OptionButton1.Caption = Sheet2.Cells(2, 3)
    .P2_OptionButton2.Caption = Sheet2.Cells(2, 4)
    .P2_OptionButton3.Caption = Sheet2.Cells(2, 5)
    .P6_OptionButton1.Caption = Sheet2.Cells(2, 3)
    .P6_OptionButton2.Caption = Sheet2.Cells(2, 4)
    .P6_OptionButton3.Caption = Sheet2.Cells(2, 5)


End With


EnableEvents = True


End Sub


Sub UpdateOwn()


EnableEvents = False


Dim cLoc As Range


EditTasks.ListBoxOwn.Clear
EditTasks.P2_ListBoxOwn.Clear


For Each cLoc In Sheet2.Range("Names")
  If cLoc.Value <> "" Then
  EditTasks.P2_ListBoxOwn.AddItem cLoc.Value
  EditTasks.ListBoxOwn.AddItem cLoc.Value
  End If
Next cLoc


EnableEvents = True


End Sub


Sub LoadIDs()


EnableEvents = False


Dim cloc2 As Range
Dim CBB() As String


i2 = 1


For Each cloc2 In Sheet1.Range("IDs")
    If cloc2.Value <> "" Then
        ReDim Preserve CBB(1 To i2) As String
        CBB(i2) = cloc2.Value & " - " & Sheet1.Cells(cloc2.Row, "C")
        i2 = i2 + 1
    End If
Next cloc2


With EditTasks
    
    .P2_ComboBoxID.List = CBB
    .P3_ComboBoxID.List = CBB
    .P4_ComboBoxID.List = CBB
    .P5_ComboBoxID.List = CBB
    .P6_ComboBoxID.List = CBB


End With


EnableEvents = True


End Sub


Sub ComboBoxIDChange(ComboBox As ComboBox, indx As Long)


ID = ReturnID(ComboBox, indx)
Call AcceptID


End Sub

Module "EditTasks_Launcher":

Code:
Option Explicit


Dim str As String
Dim Button As OptionButton


Sub TaskFunctions()


OpButSel = False


    Dur1 = Sheet2.Cells(2, 3).Value
    
    Dur2 = Sheet2.Cells(2, 4).Value
    
    Dur3 = Sheet2.Cells(2, 5).Value


For Each Button In Sheet1.OptionButtons
    If Button.Value = 1 Then
    str = Button.Name
    OpButSel = True
    End If
    Next Button


If OpButSel = True Then
ID = removeAlpha(str)
End If


EditTasks.Show


Sheet1.Unprotect


For Each Button In Sheet1.OptionButtons
    Button.Value = 0
Next Button


Sheet1.Buttons("Tasks").Caption = "New Task"


Call HideNewTask


Sheet1.Protect userinterfaceonly:=True


End Sub

Module "EditTasks_Page1":

Code:
Option Explicit


'New Task


Dim TargetRow As Long


Sub NewRow()


Dim ownLR As Long


Application.Cursor = xlWait
Application.ScreenUpdating = False
Sheet2.EnableCalculation = False


With Sheet1


    TargetRow = LastRow(Sheet1, 2) + 1
    
    If TargetRow = 3 Then ID = 1 Else ID = .Cells(TargetRow - 1, 2) + 1    'If new row is first job on sheet, set Job ID
    
    IDstr = ID
    
    .Cells(TargetRow, 2) = ID                                               'as 1. Otherwise, set it as the next in
    .Cells(TargetRow, 7) = Date                                              'series.
    .Cells(TargetRow, 8) = 0                                                 'Fill in basic details: creation date, job ID
    .Cells(TargetRow, 10) = "0"                                              'completion status and related documents count
    .Rows(TargetRow).RowHeight = 22.5                                        'Set row heights
    .Rows(TargetRow + 1).RowHeight = 15
    .Rows(TargetRow + 2).RowHeight = 5
    .Cells(TargetRow, "L") = "Green"
    
    With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Create new hidden sheet named after Job ID.
        .Name = IDstr                                                       'This sheet contains details of comments and
        .Visible = xlSheetHidden                                          'related documents associated with this task.
    End With
    
    .Activate
    
    Call TableFill                                                          'Fill rows and draw borders
    
    With .Range("B" & TargetRow & ":L" & TargetRow)
        .Borders.LineStyle = XlLineStyle.xlContinuous
        .Borders.ColorIndex = 41
        .Borders(xlInsideVertical).LineStyle = XlLineStyle.xlLineStyleNone
    End With
    
    Dim rng As Range
    
    Set rng = .Range("M" & TargetRow)
            
    With Sheet1.OptionButtons.Add(rng.Left, rng.Top, rng.Width, rng.Height) 'Create new Radio Button next to job for job
        .Name = "CommandButtonEdit" & ID                                       'selection.
        .Text = "Edit Job " & ID
        .OnAction = "EditTasks_Button.TaskChange"
    End With
    
End With
    
With EditTasks


    Dim ownVal As Integer


    Sheet1.Cells(TargetRow, 3) = .TextBoxDesc                               'Fill in details of new job in spreadsheet
    Sheet1.Cells(TargetRow, 6) = .TextBoxCust
    Erase Own
    ownVal = 0
    For i = 0 To .ListBoxOwn.ListCount - 1
        If .ListBoxOwn.Selected(i) Then
            Own(ownVal) = .ListBoxOwn.List(i)
            ownVal = ownVal + 1
        End If
    Next i
    
    If ownVal = 1 Then
        Sheet1.Cells(TargetRow, 5) = Own(0)
        Sheets(IDstr).Cells(1, 5) = Own(0)
    Else
    
    For i = 0 To ownVal
        If i = 0 Then
            Sheet1.Cells(TargetRow, 5) = Own(0)
        Else
            Sheet1.Cells(TargetRow, 5) = Sheet1.Cells(TargetRow, 5).Value & ", " & Own(i)
        End If
        Sheets(IDstr).Cells(i + 1, 5) = Own(i)
    Next i
    
    End If
    
    If Sheets(IDstr).Cells(2, 5) <> "" Then
        Sheet1.Cells(TargetRow, 5) = Left(Sheet1.Cells(TargetRow, 5).Value, Len(Sheet1.Cells(TargetRow, 5).Value) - 2)
    End If
    
    ownLR = LastRow(Sheets(IDstr), 5)
        
    ownVal = 0
    For i = 0 To .ListBoxOwn.ListCount - 1
        If .ListBoxOwn.Selected(i) = True Then
            Own(ownVal) = .ListBoxOwn.List(i)
            ownVal = ownVal + 1
        End If
    Next i
    
    Dim Present As Boolean
    
    For i = 0 To ownVal - 1
    Present = Application.Match(Own(i), Sheets(IDstr).Range("E1:E30"), 0)
        If IsNumeric(Present) = True Then
            Call Send_Email_Using_VBA(Sheet1.Cells(TargetRow, 3).Value, Sheet2.Cells(Application.Match(Own(i), Sheet2.Range("B1:B30"), 0), 6).Value)
        End If
    Next i
    
    If .OptionButton1 = True Then
    Sheet1.Cells(TargetRow, "D") = Dur1
    ElseIf .OptionButton2 = True Then
    Sheet1.Cells(TargetRow, "D") = Dur2
    ElseIf .OptionButton3 = True Then
    Sheet1.Cells(TargetRow, "D") = Dur2
    End If
    
End With


Application.Cursor = xlDefault
Application.ScreenUpdating = True
Sheet2.EnableCalculation = True


End Sub


Sub OKEnable()


Dim OptionButtons As Boolean
Dim Owners As Boolean


With EditTasks


    If .OptionButton1 = True Or .OptionButton2 = True Or .OptionButton3 = True Then OptionButtons = True
    
    For i = 0 To .ListBoxOwn.ListCount - 1
        If .ListBoxOwn.Selected(i) = True Then Owners = True
    Next i
    
    If .TextBoxDesc.Value <> "" And OptionButtons = True And Owners = True Then
        .CommandButtonOK.Enabled = True
        .CommandButtonOK.Default = True
    Else
        .CommandButtonOK.Enabled = False
        .CommandButtonCanc.Default = True
    End If


End With


End Sub

Module "EditTasks_Page2":

Code:
Option Explicit


'Edit Task


Sub EditTaskLoad()


With EditTasks
    
    EnableEvents = False
    
    Dim cntrl As Control
    For Each cntrl In .MultiPage1.Page2.Controls
        cntrl.Enabled = True
    Next cntrl
    .P2_CommandButtonOK.Enabled = False
    
    Set cntrl = Nothing
    
    .P2_TextBoxDesc = Sheet1.Cells(TargetRow, "C")
    .P2_TextBoxCust = Sheet1.Cells(TargetRow, "F")
    .P2_OptionButton1 = False
    .P2_OptionButton2 = False
    .P2_OptionButton3 = False
    
        Select Case Sheet1.Cells(TargetRow, "D")
    Case Dur1
        .P2_OptionButton1 = True
    Case Dur2
        .P2_OptionButton2 = True
    Case Dur3
        .P2_OptionButton3 = True
    End Select
    
    For i = 0 To .P2_ListBoxOwn.ListCount - 1
        If InStr(1, Sheet1.Cells(TargetRow, "E"), .P2_ListBoxOwn.List(i)) <> 0 Then
            .P2_ListBoxOwn.Selected(i) = True
        Else
            .P2_ListBoxOwn.Selected(i) = False
        End If
    Next i


Call P2_OKEnable


End With


End Sub


Sub P2_OKEnable()


Dim ownVal As Integer
Dim P2_OwnChan As Boolean


With EditTasks


    If .P2_OptionButton1 = True Then
    p2OB = Dur1
    ElseIf .P2_OptionButton2 = True Then
    p2OB = Dur2
    ElseIf .P2_OptionButton3 = True Then
    p2OB = Dur3
    End If
    
    Erase Own
    ownVal = 0
    
    For i = 0 To .P2_ListBoxOwn.ListCount - 1
        If .P2_ListBoxOwn.Selected(i) = True Then
            Own(ownVal) = .P2_ListBoxOwn.List(i)
            ownVal = ownVal + 1
        End If
    Next i
    
    P2_OwnChan = False
    
    For i = 1 To ownVal
        If Sheets(IDstr).Cells(i, 5) <> Own(i - 1) Then P2_OwnChan = True
    Next i
    
    If Sheet1.Cells(TargetRow, 3) = .P2_TextBoxDesc.Value And _
    P2_OwnChan = False And _
    Sheet1.Cells(TargetRow, 6) = .P2_TextBoxCust.Value And _
    Sheet1.Cells(TargetRow, 4) = p2OB Then
        .P2_CommandButtonOK.Enabled = False
        .P2_CommandButtonCanc.Default = True
    Else
        .P2_CommandButtonOK.Enabled = True
        .P2_CommandButtonOK.Default = True
    End If


End With


End Sub


Sub P2_OK()


Dim ownLR As Long
Dim Present As Variant


Application.EnableEvents = False


With EditTasks


    Dim ownVal As Integer


    ownVal = 0
    For i = 0 To .P2_ListBoxOwn.ListCount - 1
        If .P2_ListBoxOwn.Selected(i) = True Then
            Own(ownVal) = .P2_ListBoxOwn.List(i)
            ownVal = ownVal + 1
        End If
    Next i
    
    Sheet1.Cells(TargetRow, 3) = .P2_TextBoxDesc
    Sheet1.Cells(TargetRow, 4) = p2OB
    Sheet1.Cells(TargetRow, 6) = .P2_TextBoxCust
    
    ownLR = LastRow(Sheets(IDstr), 5)
    
    For i = 1 To ownVal
        Sheets(IDstr).Cells(i, 5) = Own(i - 1)
    Next i
    
    If ownVal = 1 Then
        Cells(TargetRow, 5) = Own(0)
        Sheets(IDstr).Cells(1, 5) = Own(0)
    Else
        For i = 0 To ownVal
            If i = 0 Then
                Sheet1.Cells(TargetRow, 5) = Own(0)
            Else
                Sheet1.Cells(TargetRow, 5) = Sheet1.Cells(TargetRow, 5).Value & ", " & Own(i)
            End If
            Sheets(IDstr).Cells(i + 1, 5) = Own(i)
        Next i
    End If
    
    If Sheets(IDstr).Cells(2, 5) <> "" Then
    Sheet1.Cells(TargetRow, 5) = Left(Sheet1.Cells(TargetRow, 5).Value, Len(Sheet1.Cells(TargetRow, 5).Value) - 2)
    End If
    
End With


EnableEvents = True


End Sub

Module "EditTasks_page3":

Code:
Option Explicit


'Related Documents


Sub RelDocLoad()


With EditTasks


    .P3_TextBoxRelDocLink1.Enabled = True
    .P3_TextBoxRelDocLink2.Enabled = True
    .P3_TextBoxRelDocName1.Enabled = True
    .P3_TextBoxRelDocName2.Enabled = True
    .P3_LabelRelDoc = "Job " & ID & vbNewLine & "Add Related Documents"
    
    .P3_TextBoxRelDocLink1 = "Link"
    .P3_TextBoxRelDocLink2 = "Link"
    .P3_TextBoxRelDocName1 = "Name"
    .P3_TextBoxRelDocName2 = "Name"
    
    Call P3_FilledChecker
    
    .P3_CommandButtonOK.Enabled = False
    
    If Sheet1.Cells(TargetRow, "J") = 0 Then .CommandButton1.Enabled = False Else .CommandButton1.Enabled = True
    
    RDMID = True


End With


End Sub


Sub P3_FilledChecker()


With EditTasks


    If .P3_TextBoxRelDocName1 <> "Name" _
    And .P3_TextBoxRelDocLink1 <> "Link" _
    And .P3_TextBoxRelDocName2 <> "Name" _
    And .P3_TextBoxRelDocLink2 <> "Link" Then
        
        .P3_TextBoxRelDocName1 = Sheet3.Cells(RelDoc1Counter + 1, 1)
        .P3_TextBoxRelDocLink1 = Sheet3.Cells(RelDoc1Counter + 1, 2)
        .P3_TextBoxRelDocName2 = Sheet3.Cells(RelDoc2Counter + 1, 1)
        .P3_TextBoxRelDocLink2 = Sheet3.Cells(RelDoc2Counter + 1, 2)
        
        RelDoc1Counter = RelDoc1Counter + 1
        RelDoc2Counter = RelDoc2Counter + 1
        
        .P3_TextBoxRelDocName2.SetFocus
        
    Else
        Exit Sub
    End If
    
    If P3ComButUp = True Then
        .P3_CommandButtonRelDocUp.Visible = True
    Else
        .P3_CommandButtonRelDocUp.Visible = False
    End If
    
    If .P3_TextBoxRelDocName1 = "" Or .P3_TextBoxRelDocName1 = "Name" Then
        .P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
        .P3_TextBoxRelDocName1 = "Name"
    Else
        .P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
    End If
    
    If .P3_TextBoxRelDocLink1 = "" Or .P3_TextBoxRelDocLink1 = "Link" Then
        .P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
        .P3_TextBoxRelDocLink1 = "Link"
    Else
        .P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)
    End If
    
    If .P3_TextBoxRelDocName2 = "" Or .P3_TextBoxRelDocName2 = "Name" Then
        .P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
        .P3_TextBoxRelDocName2 = "Name"
    Else
        .P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
    End If
    
    If .P3_TextBoxRelDocLink2 = "" Or .P3_TextBoxRelDocLink2 = "Link" Then
        .P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
        .P3_TextBoxRelDocLink2 = "Link"
    Else
        .P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
    End If


End With


End Sub


Function P3ComButUp()


On Error GoTo P3ComButUpErrorcatcher


If Sheet3.Cells(RelDoc1Counter - 1, 1) <> "" Or Sheet3.Cells(RelDoc1Counter - 1, 2) <> "" Then
    P3ComButUp = True
Else
    P3ComButUp = False
End If
    
Exit Function


P3ComButUpErrorcatcher:


P3ComButUp = False


End Function


Function P3ComButDown()


On Error GoTo P3ComButDownErrorcatcher


If Sheet3.Cells(RelDoc2Counter, 1) <> "" Or Sheet3.Cells(RelDoc2Counter, 2) <> "" Then
    P3ComButDown = True
Else
    P3ComButDown = False
End If


Exit Function


P3ComButDownErrorcatcher:


P3ComButDown = False


End Function

Module "EditTasks_Page4":

Code:
Option Explicit


'Comments


Sub CommentsLoad()


With EditTasks


    .P4_TextBoxCom.Enabled = True
    .P4_LabelCom = "Add Comment" & vbNewLine & "Job " & ID
    CMID = True
    
    If Sheets(IDstr).Cells(1, 3) = "" Then
        .P4_CommandButtonCM.Enabled = False
    Else
        .P4_CommandButtonCM.Enabled = True
    End If
    
    .P4_TextBoxCom = ""
    .P4_CommandButtonOK.Enabled = False


End With


End Sub


Sub UpdateComments()


If Sheets(IDstr).Cells(1, 3) <> "" Then


For i = 1 To LastRow(Sheets(IDstr), 3)
    
    Sheets(IDstr).Cells(i, 3) = Sheet4.Cells(i, 1)
    Sheets(IDstr).Cells(i, 4) = Sheet4.Cells(i, 2) & "; " & Sheet4.Cells(i, 3)
    If i = 1 Then
        Sheet1.Cells(TargetRow, 11) = Sheets(IDstr).Cells(i, 3) & " - " & Sheets(IDstr).Cells(i, 4)
    Else
        Sheet1.Cells(TargetRow, 11) = Sheet1.Cells(TargetRow, 11) & vbNewLine & Sheets(IDstr).Cells(i, 3) & " - " & Sheets(IDstr).Cells(i, 4)
    End If
    Next i
Else
    Sheet1.Cells(TargetRow, 11) = ""
End If


End Sub


Sub P4_OK()


Dim LastRowC As Long
Dim tempstr As String


With EditTasks


    tempstr = "Add comment" & vbNewLine & "~" & .P4_TextBoxCom & "~" & vbNewLine & "To Job " & ID & "?"
    tempstr = Replace(tempstr, Chr(126), Chr(34))
    Answer = MsgBox(tempstr, vbOKCancel, "Confirm Comment")
    If Not Answer = vbYes Then Exit Sub
    
    LastRowC = LastRow(Sheets(IDstr), 3)
    
    If Sheets(IDstr).Cells(LastRowC, 3) = "" Then
        Sheets(IDstr).Cells(LastRowC, 3) = .P4_TextBoxCom
        Sheets(IDstr).Cells(LastRowC, 4) = Application.UserName & "; " & Date
        Sheet1.Cells(TargetRow, 11) = .P4_TextBoxCom & " - " & Application.UserName & "; " & Date
    Else
        Sheets(IDstr).Cells(LastRowC + 1, 3) = .P4_TextBoxCom
        Sheets(IDstr).Cells(LastRowC + 1, 4) = Application.UserName & "; " & Date
        Sheet1.Cells(TargetRow, "K") = Sheet1.Cells(TargetRow, "K") & vbNewLine & .P4_TextBoxCom & " - " & Application.UserName & "; " & Date
    End If
    
    MsgBox "Comment successfully added.", vbOKOnly, "Success!"
    
End With


End Sub

Module "EditTasks_Page5":

Code:
Option Explicit


'Completion


Sub Completi******()


With EditTasks


    If Sheet1.Cells(TargetRow, "H") = 0 Then
        .P5_CheckBoxComp = False
        .P5_CheckBoxComp.Caption = ""
    Else
        .P5_CheckBoxComp = True
        .P5_CheckBoxComp.Caption = "Completion Date: " & Sheet1.Cells(TargetRow, "I")
    End If
    
End With


End Sub


Sub Complete()


Answer = MsgBox("Mark task " & ID & " as completed?", vbYesNo + vbQuestion, "Complete Task")
If Answer <> vbYes Then Exit Sub


Sheet1.Cells(TargetRow, "H") = 1
Sheet1.Cells(TargetRow, "I") = Date




End Sub


Sub Uncomplete()


Answer = MsgBox("Mark task " & ID & " as incomplete?", vbYesNo + vbQuestion, "Task Incomplete")
If Answer <> vbYes Then Exit Sub


Sheet1.Cells(TargetRow, "H") = 0
Sheet1.Cells(TargetRow, "I").ClearContents


End Sub

Module "EditTasks_Page6":

Code:
Option Explicit


'Delete Task


Sub DeleteLoad()


With EditTasks
    
    .P6_CommandButtonDel.Enabled = True
    .P6_LabelDesc2.Caption = Sheet1.Cells(TargetRow, "C")
    .P6_LabelOwn2.Caption = Sheet1.Cells(TargetRow, "E")
    .P6_LabelCust2.Caption = Sheet1.Cells(TargetRow, "F")
    .P6_OptionButton1 = False
    .P6_OptionButton2 = False
    .P6_OptionButton3 = False
    
    Select Case Sheet1.Cells(TargetRow, "D")
    Case Dur1
        .P6_OptionButton1 = True
    Case Dur2
        .P6_OptionButton2 = True
    Case Dur3
        .P6_OptionButton3 = True
    End Select
    
    .P6_OptionButton1.Locked = True
    .P6_OptionButton2.Locked = True
    .P6_OptionButton3.Locked = True


End With


End Sub


Sub DeleteRow()


With Sheet1


    Application.Cursor = xlWait
    Sheet2.EnableCalculation = False
    Application.EnableEvents = False
    
    .Unprotect
    
    .OptionButtons("CommandButtonEdit" & ID).Delete
    
    .Rows(TargetRow).Delete                               'Also deletes associated worksheet.
    
    Call ResetRowHeights
    
    .Rows(LastRow(Sheet1, 2) + 1).RowHeight = 15
    .Rows(LastRow(Sheet1, 2) + 2).RowHeight = 5
    
    On Error Resume Next
        
        Application.DisplayAlerts = False
        Sheets(IDstr).Delete
        Application.DisplayAlerts = True
    
    Application.Cursor = xlDefault
    Sheet1.EnableCalculation = True
    Application.EnableEvents = True


End With


End Sub

Just for info the ShowPopup procedure is a right click menu generator - I've tried commenting it out, but to no avail...
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,215,523
Messages
6,125,318
Members
449,218
Latest member
Excel Master

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top